Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Access/Excel VBA Question about my code.

Status
Not open for further replies.
RodgerDJr

RodgerDJr

MIS
Mar 8, 2002
15
US
All,

I have a Public Function in Access that will read from my tables and create a formatted Excel Spreadsheet. It works most of the time, other times I get errors at various spots Object variable or With block variable not set, Error 91, Application-defined or Object-defined error, Error 1004. I think it could be the way I am call Excel, but I am not sure this is my first attempt at doing this. I have do a lot of VBA programing in Access and have not done much in Excel in a long time.

If I change xlApp.Visible = True to False, I get Object variable or With block variable not set, Error 91 99% of the time.

Here is my code. I put a note in on the two lines I get the errors on sometimes. I can run this code a few times with out an issue and then I run it again without changing anything and I get on of the errors.

I am up for suggestions.

TIA,
Rodger

Code: 
Option Compare Database

Public Function CreateExcel(Optional myEmpoyeeNumber As Integer)

Dim xlApp As Object
Dim myMessage, myStyle, myTitle, myResult
Dim mySQL, myDB, myRS1, myRS2
Dim myColorIndex As Integer
Dim myColor, x, y, z
Dim myValue1, myValue2, myStatus1, myStatus2
Dim myProjectManager, myLeadAnalyst, myTSG, myEmpSQL

'On Error GoTo Err_CreateExcel

'Create Excel Workbook
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False
    xlApp.Workbooks.Add

    Set myDB = CurrentDb()
    mySQL = "SELECT * FROM dbo_CATEGORIES"
    
    Set myRS2 = myDB.OpenRecordset(mySQL, dbOpenDynaset, dbSeeChanges)
    
    x = 1
    y = 7
    z = xlApp.Worksheets(1).UsedRange.Rows.Count
    
    'Rename the sheet
    If Nz(myEmpoyeeNumber, "0") = "0" Then
        xlApp.Worksheets(1).Name = "All Projects"
    Else
        xlApp.Worksheets(1).Name = myEmpoyeeNumber
    End If
    
    Do Until myRS2.EOF
        myColorIndex = myRS2!CAT_COLOR_INDEX
        xlApp.Worksheets(1).Cells(x, y).Select
            With Selection
                .Interior.ColorIndex = myColorIndex  [COLOR=red]'<< Runtime 91 sometimes[/color]
                .Interior.Pattern = xlSolid
            End With
        xlApp.Worksheets(1).Cells(x, y + 1).Value = myRS2.CAT_DESCRIPTION
        x = x + 1
        myRS2.MoveNext
    Loop
    
'Create the headers
    xlApp.Worksheets(1).Cells(1, 2).Value = "INFORMATION SYSTEMS PROJECTS"
    xlApp.Worksheets(1).Cells(1, 3).Value = Date

    xlApp.Worksheets(1).Cells(6, 2).Value = "Project"
    xlApp.Worksheets(1).Cells(6, 3).Value = "Customer"
    xlApp.Worksheets(1).Cells(6, 4).Value = "Original Hours Estimated"
    xlApp.Worksheets(1).Cells(6, 5).Value = "Actual Hours Expended"
    xlApp.Worksheets(1).Cells(6, 6).Value = "Estimated Hours Remaining"
    xlApp.Worksheets(1).Cells(6, 7).Value = "Original Target Completion"
    xlApp.Worksheets(1).Cells(6, 8).Value = "New Target Completion"
    xlApp.Worksheets(1).Cells(6, 9).Value = "Resources"
    xlApp.Worksheets(1).Cells(6, 10).Value = "Comments"
        
    xlApp.Worksheets(1).Cells(7, 3).Select
    ActiveWindow.FreezePanes = True
    
    Rows("6:6").RowHeight = 33.75
    
    Columns("A:A").ColumnWidth = 3
    Columns("B:B").ColumnWidth = 49.43
    Columns("C:C").ColumnWidth = 27.29
    Columns("D:D").ColumnWidth = 10
    Columns("E:E").ColumnWidth = 11.14
    Columns("F:F").ColumnWidth = 12.57
    Columns("G:G").ColumnWidth = 11.86
    Columns("H:H").ColumnWidth = 14.29
    Columns("I:I").ColumnWidth = 32
    Columns("J:J").ColumnWidth = 12
    
    xlApp.Worksheets(1).Range(Cells(6, 2), Cells(6, 10)).Select  [COLOR=red]'<< Runtime 1004 sometimes [/color]
    Selection.Font.Bold = True
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Interior
        .ColorIndex = 15
        .Pattern = xlSolid
    End With

    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    If IsNull(myEmpoyeeNumber) Or myEmpoyeeNumber = 0 Then
        myEmpSQL = ""
    Else
        myEmpSQL = "AND ((PM.EMP_NUMBER)=" & myEmpoyeeNumber & ") OR (((LAN.EMP_NUMBER)=" & myEmpoyeeNumber & ")) OR (((TSG.EMP_NUMBER)=" & myEmpoyeeNumber & ")) OR (((EmployeeSingleLineNumber([P].[PRO_ID])) In ('" & myEmpoyeeNumber & "'))) "
    End If

    mySQL = "SELECT S.STA_ID, S.STA_DESCRIPTION, P.PRO_LINE_NUMBER, P.PRO_NAME, C.CAT_DESCRIPTION, C.CAT_COLOR_INDEX, C.CAT_COLOR, PP.PAP_ID, PP.PAP_DESCRIPTION, PM.NAME_LF AS PROJECT_MANAGER, LAN.NAME_LF AS LEAD_ANALYST, TSG.NAME_LF AS TSG, PHO.PROJECT_HOURS_ORIGINAL, PHC.PROJECT_HOURS_CURRENT, PSDO.PROJECT_START_DATE_ORIGINAL, PSDC.PROJECT_START_DATE_CURRENT, P.PRO_ORIGINAL_DATE, CustomerSingleLine(P.PRO_ID) AS CUSTOMER, EmployeeSingleLine(P.PRO_ID) AS RESOURCES, PH.HOURS, PH.HOURS_EXPENDED, PH.HORS_LEFT, PM.EMP_NUMBER AS PROJECT_MANAGER_NUMBER, LAN.EMP_NUMBER AS LEAD_ANALYST_NUMBER, TSG.EMP_NUMBER AS TSG_NUMBER, EmployeeSingleLineNumber([P].[PRO_ID]) AS RESOURCES_NUMBER " & _
            "FROM ((((((((((dbo_PROJECTS AS P LEFT JOIN qry_Project_Hours_Current AS PHC ON P.PRO_ID = PHC.PRH_PRO_ID) LEFT JOIN qry_Project_Hours_Original AS PHO ON P.PRO_ID = PHO.PRH_PRO_ID) LEFT JOIN qry_Project_Start_Date_Original AS PSDO ON P.PRO_ID = PSDO.PSD_PRO_ID) LEFT JOIN qry_Project_Start_Date_Current AS PSDC ON P.PRO_ID = PSDC.PSD_PRO_ID) LEFT JOIN qry_Employee_Names AS PM ON P.PRO_PM_ID = PM.EMP_NUMBER) LEFT JOIN qry_Employee_Names AS LAN ON P.PRO_LAN_ID = LAN.EMP_NUMBER) LEFT JOIN qry_Employee_Names AS TSG ON P.PRO_TSG_ID = TSG.EMP_NUMBER) LEFT JOIN dbo_PARENT_PROJECTS AS PP ON P.PRO_PAP_ID = PP.PAP_ID) LEFT JOIN dbo_STATUS AS S ON P.PRO_STA_ID = S.STA_ID) LEFT JOIN dbo_CATEGORIES AS C ON P.PRO_CAT_ID = C.CAT_ID) LEFT JOIN qry_ProjectHours_Step3 AS PH ON P.PRO_ID = PH.PRO_ID " & _
            "WHERE ((P.PRO_LINE_NUMBER)<>'1000') " & myEmpSQL & _
            "ORDER BY S.STA_ID, P.PRO_LINE_NUMBER, P.PRO_NAME;"

    
    Set myRS1 = myDB.OpenRecordset(mySQL, dbOpenDynaset, dbSeeChanges)
    
    x = 7
    y = 1
    myStatus1 = myRS1!STA_DESCRIPTION
    
    Do Until myRS1.EOF
        
            If myStatus1 <> myStatus2 Then
                xlApp.Worksheets(1).Cells(x, y + 1).Value = myStatus1
                xlApp.Worksheets(1).Cells(x, y + 1).Select
                    With Selection
                        .Font.Bold = True
                        .HorizontalAlignment = xlCenter
                    End With
                x = x + 1
            Else
                'Does the project have a status if yes put the color index in the first cell for the row.
                If IsNull(myRS1!CAT_COLOR_INDEX) Then
                
                Else
                    myColorIndex = myRS1!CAT_COLOR_INDEX
                    'xlApp.Worksheets(1).Range(Cells(x, y), Cells(x, y)).Select
                    xlApp.Worksheets(1).Cells(x, y).Select
                        With Selection
                            .Interior.ColorIndex = myColorIndex
                            .Interior.Pattern = xlSolid
                        End With
                End If
            
                'Start listing out the project.
                xlApp.Worksheets(1).Cells(x, y + 1).Value = myRS1!PRO_LINE_NUMBER & " - " & myRS1!PRO_NAME
                xlApp.Worksheets(1).Cells(x, y + 2).Value = myRS1!CUSTOMER
                xlApp.Worksheets(1).Cells(x, y + 3).Value = myRS1!HOURS
                xlApp.Worksheets(1).Cells(x, y + 4).Value = myRS1!HOURS_EXPENDED
                xlApp.Worksheets(1).Cells(x, y + 5).Value = myRS1!HORS_LEFT
                xlApp.Worksheets(1).Cells(x, y + 6).Value = myRS1!PROJECT_START_DATE_ORIGINAL
                xlApp.Worksheets(1).Cells(x, y + 7).Value = myRS1!PROJECT_START_DATE_CURRENT
                'Get Project Manager, Lead Analyst, TSG ro add to the resources section
                    
                    If IsNull(myRS1!PROJECT_MANAGER) Or myRS1!PROJECT_MANAGER = "" Then
                        myProjectManger = ""
                    Else
                        If IsNull(myRS1!RESOURCES) Or myRS1!RESOURCES = "" Then
                            myProjectManger = myRS1!PROJECT_MANAGER
                        Else
                            myProjectManger = myRS1!PROJECT_MANAGER & ", "
                        End If
                    End If
                    
                    If IsNull(myRS1!LEAD_ANALYST) Or myRS1!LEAD_ANALYST = "" Then
                        myLeadAnalyst = ""
                    Else
                        If IsNull(myRS1!RESOURCES) Or myRS1!RESOURCES = "" Then
                            myLeadAnalyst = myRS1!LEAD_ANALYST
                        Else
                            myLeadAnalyst = myRS1!LEAD_ANALYST & ", "
                        End If

                    End If
                    
                    If IsNull(myRS1!TSG) Or myRS1!TSG = "" Then
                        myTSG = ""
                    Else
                        If IsNull(myRS1!RESOURCES) Or myRS1!RESOURCES = "" Then
                            myTSG = myRS1!TSG
                        Else
                            myTSG = myRS1!TSG & ", "
                        End If
                    End If
                
                
                xlApp.Worksheets(1).Cells(x, y + 8).Value = myProjectManager & myLeadAnalyst & myTSG & myRS1!RESOURCES
                
                'xlApp.Worksheets(1).Cells(x, y + 1).Select
                
            End If
    x = x + 1
    y = 1
    myStatus1 = myRS1!STA_DESCRIPTION
    myRS1.MoveNext
        
        If myRS1.EOF Then
        Else
            myStatus2 = myRS1!STA_DESCRIPTION
        End If
        'MsgBox ("myStatus1 = " & myStatus1 & vbCrLf & "myStatus2 = " & myStatus2)
    Loop
    
    'Right align hours
    xlApp.Worksheets(1).Range(Cells(8, 4), Cells(x, 6)).Select
        With Selection
            .HorizontalAlignment = xlRight
        End With
    'Date format
    xlApp.Worksheets(1).Range(Cells(8, 7), Cells(x, 8)).Select
        Selection.NumberFormat = "m/d/yyyy;@"
    'Wrap text for Resources
    xlApp.Worksheets(1).Range(Cells(8, 9), Cells(x, 9)).Select
        With Selection
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .WrapText = True
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
    z = xlApp.Worksheets(1).UsedRange.Rows.Count
    xlApp.Worksheets(1).Cells(7, 3).Select
        MsgBox "Export Completed.  Number of rows " & z
        xlApp.Visible = True
        
Set xlApp = Nothing
        
Exit_CreateExcel:
    Exit Function
    
Err_CreateExcel:
        Beep
        MsgBox Err.Number & " - " & Err.Description
        'Resume Exit_CreateExcel
        Exit Function
           
End Function
 
Sort by date Sort by votes
OK guys thank you for all your help I really appriciate it.

I have modified the function with your suggestions, but I am getting hung up on a section and I am not sure if is my placement of With and End With.

I am getting Object does not support this property or method.

The line is pretty far down.

Thanks again.

Code: 
Public Function CreateExcel(Optional myEmployeeNumber As Integer)

Dim xlApp As Object
Dim myMessage, myStyle, myTitle, myResult
Dim mySQL, myDB, myRS1, myRS2, myRS3
Dim myColorIndex As Integer
Dim myColor, x, y, z
Dim myValue1, myValue2, myStatus1, myStatus2
Dim myProjectManager, myLeadAnalyst, myTSG, myEmpSQL, mySingleEmployee

'On Error GoTo Err_CreateExcel

'Create Excel Workbook
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    DoCmd.Echo True, "Creating Excel Worksheet"
    
    Set myDB = CurrentDb()
    
    mySQL = "SELECT * FROM dbo_CATEGORIES"
    Set myRS2 = myDB.OpenRecordset(mySQL, dbOpenDynaset, dbSeeChanges)
    
    mySQL = "SELECT * FROM qry_Employee_Names WHERE EMP_NUMBER=" & myEmployeeNumber
    Set myRS3 = myDB.OpenRecordset(mySQL, dbOpenDynaset, dbSeeChanges)
    If myRS3.EOF Then
       
    Else
        mySingleEmployee = myRS3!NAME_FL
    End If
    
    With xlApp.Workbooks.Add
    x = 1
    y = 7
    z = .Worksheets(1).UsedRange.Rows.Count
    
    'Rename the sheet
    If Nz(myEmpoyeeNumber, "0") = "0" Then
        .Worksheets(1).Name = "All Projects"
    Else
        .Worksheets(1).Name = mySingleEmployee
    End If
    
    DoCmd.Echo True, "Creating Categories"
    
    Do Until myRS2.EOF
        myColorIndex = myRS2!CAT_COLOR_INDEX
        
            With .Worksheets(1).Cells(x, y)
                 .Interior.ColorIndex = myColorIndex
                 .Interior.Pattern = xlSolid
            End With
        .Worksheets(1).Cells(x, y + 1).Value = myRS2.CAT_DESCRIPTION
        x = x + 1
        myRS2.MoveNext
    Loop
    
'Create the headers
    DoCmd.Echo True, "Creating Headers"
    .Worksheets(1).Cells(1, 2).Value = "INFORMATION SYSTEMS PROJECTS"
    .Worksheets(1).Cells(1, 3).Value = Date

    .Worksheets(1).Cells(6, 2).Value = "Project"
    .Worksheets(1).Cells(6, 3).Value = "Customer"
    .Worksheets(1).Cells(6, 4).Value = "Original Hours Estimated"
    .Worksheets(1).Cells(6, 5).Value = "Actual Hours Expended"
    .Worksheets(1).Cells(6, 6).Value = "Estimated Hours Remaining"
    .Worksheets(1).Cells(6, 7).Value = "Original Target Completion"
    .Worksheets(1).Cells(6, 8).Value = "New Target Completion"
    .Worksheets(1).Cells(6, 9).Value = "Resources"
    .Worksheets(1).Cells(6, 10).Value = "Comments"
        
    With .Worksheets(1)
        .Cells(7, 3).Select
        xlApp.ActiveWindow.FreezePanes = True
    
        .Rows("6:6").RowHeight = 33.75
    
        .Columns("A:A").ColumnWidth = 3
        .Columns("B:B").ColumnWidth = 49.43
        .Columns("C:C").ColumnWidth = 27.29
        .Columns("D:D").ColumnWidth = 10
        .Columns("E:E").ColumnWidth = 11.14
        .Columns("F:F").ColumnWidth = 12.57
        .Columns("G:G").ColumnWidth = 11.86
        .Columns("H:H").ColumnWidth = 14.29
        .Columns("I:I").ColumnWidth = 32
        .Columns("J:J").ColumnWidth = 12
    
    With .Range(.Cells(6, 2), .Cells(6, 10))
         .Font.Bold = True
         .Borders(xlDiagonalDown).LineStyle = xlNone
         .Borders(xlDiagonalUp).LineStyle = xlNone
         .Borders(xlEdgeLeft).LineStyle = xlContinuous
         .Borders(xlEdgeRight).LineStyle = xlContinuous
         .Borders(xlEdgeTop).LineStyle = xlContinuous
         .Borders(xlEdgeBottom).LineStyle = xlContinuous
         .Interior.ColorIndex = 15
         .Interior.Pattern = xlSolid
         .HorizontalAlignment = xlCenter
         .VerticalAlignment = xlCenter
         .WrapText = True
         .Orientation = 0
         .AddIndent = False
         .IndentLevel = 0
         .ShrinkToFit = False
         .ReadingOrder = xlContext
         .MergeCells = False
    End With

    If IsNull(myEmployeeNumber) Or myEmployeeNumber = 0 Then
        myEmpSQL = ""
    Else
        myEmpSQL = "AND ((PM.EMP_NUMBER)=" & myEmployeeNumber & ") OR (((LAN.EMP_NUMBER)=" & myEmployeeNumber & ")) OR (((TSG.EMP_NUMBER)=" & myEmployeeNumber & ")) OR (((EmployeeSingleLineNumber([P].[PRO_ID])) In ('" & myEmployeeNumber & "'))) "
    End If

    mySQL = "SELECT S.STA_ID, S.STA_DESCRIPTION, P.PRO_LINE_NUMBER, P.PRO_NAME, C.CAT_DESCRIPTION, C.CAT_COLOR_INDEX, C.CAT_COLOR, PP.PAP_ID, PP.PAP_DESCRIPTION, PM.NAME_LF AS PROJECT_MANAGER, LAN.NAME_LF AS LEAD_ANALYST, TSG.NAME_LF AS TSG, PHO.PROJECT_HOURS_ORIGINAL, PHC.PROJECT_HOURS_CURRENT, PSDO.PROJECT_START_DATE_ORIGINAL, PSDC.PROJECT_START_DATE_CURRENT, P.PRO_ORIGINAL_DATE, CustomerSingleLine(P.PRO_ID) AS CUSTOMER, EmployeeSingleLine(P.PRO_ID) AS RESOURCES, PH.HOURS, PH.HOURS_EXPENDED, PH.HORS_LEFT, PM.EMP_NUMBER AS PROJECT_MANAGER_NUMBER, LAN.EMP_NUMBER AS LEAD_ANALYST_NUMBER, TSG.EMP_NUMBER AS TSG_NUMBER, EmployeeSingleLineNumber([P].[PRO_ID]) AS RESOURCES_NUMBER " & _
            "FROM ((((((((((dbo_PROJECTS AS P LEFT JOIN qry_Project_Hours_Current AS PHC ON P.PRO_ID = PHC.PRH_PRO_ID) LEFT JOIN qry_Project_Hours_Original AS PHO ON P.PRO_ID = PHO.PRH_PRO_ID) LEFT JOIN qry_Project_Start_Date_Original AS PSDO ON P.PRO_ID = PSDO.PSD_PRO_ID) LEFT JOIN qry_Project_Start_Date_Current AS PSDC ON P.PRO_ID = PSDC.PSD_PRO_ID) LEFT JOIN qry_Employee_Names AS PM ON P.PRO_PM_ID = PM.EMP_NUMBER) LEFT JOIN qry_Employee_Names AS LAN ON P.PRO_LAN_ID = LAN.EMP_NUMBER) LEFT JOIN qry_Employee_Names AS TSG ON P.PRO_TSG_ID = TSG.EMP_NUMBER) LEFT JOIN dbo_PARENT_PROJECTS AS PP ON P.PRO_PAP_ID = PP.PAP_ID) LEFT JOIN dbo_STATUS AS S ON P.PRO_STA_ID = S.STA_ID) LEFT JOIN dbo_CATEGORIES AS C ON P.PRO_CAT_ID = C.CAT_ID) LEFT JOIN qry_ProjectHours_Step3 AS PH ON P.PRO_ID = PH.PRO_ID " & _
            "WHERE ((P.PRO_LINE_NUMBER)<>'1000') " & myEmpSQL & _
            "ORDER BY S.STA_ID, P.PRO_LINE_NUMBER, P.PRO_NAME;"

    
    Set myRS1 = myDB.OpenRecordset(mySQL, dbOpenDynaset, dbSeeChanges)
    
    x = 7
    y = 1
    myStatus1 = myRS1!STA_DESCRIPTION
    
    Do Until myRS1.EOF
        
            If myStatus1 <> myStatus2 Then
 [COLOR=red][b] .Worksheets(1).Cells(x, y + 1).Value = myStatus1[/b][/color]  << This is the line I am getting an error 438 Object does not support.
                    With .Worksheets(1).Cells(x, y + 1)
                         .Font.Bold = True
                         .HorizontalAlignment = xlCenter
                    End With
                x = x + 1
            Else
                'Does the project have a status if yes put the color index in the first cell for the row.
                If IsNull(myRS1!CAT_COLOR_INDEX) Then
                
                Else
                    myColorIndex = myRS1!CAT_COLOR_INDEX
                    
                        With .Worksheets(1).Cells(x, y)
                             .Interior.ColorIndex = myColorIndex
                             .Interior.Pattern = xlSolid
                        End With
                End If
            
                'Start listing out the project.
                .Worksheets(1).Cells(x, y + 1).Value = myRS1!PRO_LINE_NUMBER & " - " & myRS1!PRO_NAME
                .Worksheets(1).Cells(x, y + 2).Value = myRS1!CUSTOMER
                .Worksheets(1).Cells(x, y + 3).Value = myRS1!HOURS
                .Worksheets(1).Cells(x, y + 4).Value = myRS1!HOURS_EXPENDED
                .Worksheets(1).Cells(x, y + 5).Value = myRS1!HORS_LEFT
                .Worksheets(1).Cells(x, y + 6).Value = myRS1!PROJECT_START_DATE_ORIGINAL
                .Worksheets(1).Cells(x, y + 7).Value = myRS1!PROJECT_START_DATE_CURRENT
                'Get Project Manager, Lead Analyst, TSG ro add to the resources section
                    
                    If IsNull(myRS1!PROJECT_MANAGER) Or myRS1!PROJECT_MANAGER = "" Then
                        myProjectManger = ""
                    Else
                        If IsNull(myRS1!RESOURCES) Or myRS1!RESOURCES = "" Then
                            myProjectManger = myRS1!PROJECT_MANAGER
                        Else
                            myProjectManger = myRS1!PROJECT_MANAGER & ", "
                        End If
                    End If
                    
                    If IsNull(myRS1!LEAD_ANALYST) Or myRS1!LEAD_ANALYST = "" Then
                        myLeadAnalyst = ""
                    Else
                        If IsNull(myRS1!RESOURCES) Or myRS1!RESOURCES = "" Then
                            myLeadAnalyst = myRS1!LEAD_ANALYST
                        Else
                            myLeadAnalyst = myRS1!LEAD_ANALYST & ", "
                        End If

                    End If
                    
                    If IsNull(myRS1!TSG) Or myRS1!TSG = "" Then
                        myTSG = ""
                    Else
                        If IsNull(myRS1!RESOURCES) Or myRS1!RESOURCES = "" Then
                            myTSG = myRS1!TSG
                        Else
                            myTSG = myRS1!TSG & ", "
                        End If
                    End If
                
                
                .Worksheets(1).Cells(x, y + 8).Value = myProjectManager & myLeadAnalyst & myTSG & myRS1!RESOURCES
                
                '.Worksheets(1).Cells(x, y + 1).Select
                
            End If
    x = x + 1
    y = 1
    myStatus1 = myRS1!STA_DESCRIPTION
    myRS1.MoveNext
        
        If myRS1.EOF Then
        Else
            myStatus2 = myRS1!STA_DESCRIPTION
        End If
        'MsgBox ("myStatus1 = " & myStatus1 & vbCrLf & "myStatus2 = " & myStatus2)
    Loop
    
    'Right align hours
        With .Range(.Cells(8, 4), .Cells(x, 6))
             .HorizontalAlignment = xlRight
        End With
    'Date format
        With .Range(.Cells(8, 7), .Cells(x, 8))
             .NumberFormat = "m/d/yyyy;@"
        End With
    'Wrap text for Resources
        With .Range(.Cells(8, 9), .Cells(x, 9))
             .HorizontalAlignment = xlGeneral
             .VerticalAlignment = xlBottom
             .WrapText = True
             .Orientation = 0
             .AddIndent = False
             .IndentLevel = 0
             .ShrinkToFit = False
             .ReadingOrder = xlContext
             .MergeCells = False
        End With
    z = .Worksheets(1).UsedRange.Rows.Count
        .Worksheets(1).Cells(7, 3).Select
            MsgBox "Export Completed.  Number of rows " & z
        xlApp.Visible = True
   End With
End With
Set xlApp = Nothing
        
Exit_CreateExcel:
    Exit Function
    
Err_CreateExcel:
        Beep
        MsgBox Err.Number & " - " & Err.Description
        'Resume Exit_CreateExcel
        Exit Function
           
End Function
 
Upvote 0 Downvote



You are ALREADY referencing With .Worksheets(1)...

and then WITHIN that With...End With you have a .Worksheets(1)..........

Go to clean up your PARINGS.

The VB Editor does the best it can to return a relevant error message, but not always!!!

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
You told me that before, how did I miss that!!! Thank you it works beautiful. Now I am going to make another one that will add a tab for each employee and the projects they are working on and have a master. That will be my new challenge.

THANK YOU AGAIN!!
 
Upvote 0 Downvote
OK that fixed that . . .

[Code VBA\With .Worksheets(1).Range(Cells(6, 2), Cells(6, 10))</code>

I am getting a runtime 1004 Method 'Cells' of Object '_Global' failed. We fix one and break another one . . . .


 
Upvote 0 Downvote
Now I am going to make another one that will [red]add a tab for each employee and the projects they are working on[/red]..
Click to expand...
[red]Say, "It ain't so," Joe![/red]

By chopping your data up into separate sheets, you will be [red]multiplying your woes![/red]

Similar data, like Employee Data or Project Data, ought to be in a single table (sheet) if you plan on using this data for other reporting, like some sort of summary. If you have to AGGREGATE across multiple sheets, it becomes a nightmare!

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
runtime 1004 Method 'Cells' of Object '_Global' failed
Please, reread my reply timestamped 12 Jun 12 18:15
 
Upvote 0 Downvote
PHV - My browser must have gone crazy and resubmitted it. I was not even at my PC then. But thank you.
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

M
  • Locked
  • Question
display a calendar with appointments in body of html email with access vba
Replies
1
Views
2K
SoftwareRT
SoftwareRT
Moss100
  • Locked
  • Question
Filter vba problem
Replies
1
Views
476
Andrzejek
Andrzejek
Omarahmed22
  • Locked
  • Question
VBA Formating
Replies
1
Views
411
Andrzejek
Andrzejek
DarkOne72
  • Locked
  • Question
MS Access DoCmd.Transferdatabase Assistance
Replies
2
Views
1K
lameid
lameid
Knicks
  • Locked
  • Question
Microsoft Access VBA Coding to Excel (early binding) 1
Replies
2
Views
695
Knicks
Knicks

Part and Inventory Search

Sponsor

Back
Top