Excel code error

D

dark11984

Registered User.
Local time
Tomorrow, 08:11
Joined
Mar 3, 2008
Messages
129
Hi I'm using code in an Aceess Database to export a query to excel then format the spreadsheet.

if i run the code once, it works fine but if i run it again i get an error message - "Run-time error '1004': Method 'Columns' of object '_Global' failed.

It hangs on:
Code: 
 j = objexcelapp.WorksheetFunction.CountIf(Columns("B:B"), "Core Fleet")

Code: 
Private Sub CmdRateCardExport_Click()
'On Error GoTo Err_CmdRateCardExport_Click
    Dim CMS As String
    Dim Site As String
    
    CMS = Forms!frmratecardentry!CboCMSRef
    Site = Forms!frmratecardentry!CboSite
    
    Kill ("C:\data\book1.xls")
    
    'Export QryRateCardExport from Rate Card Database
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "QrycardExport", "C:\data\book1.xls", True, CMS & "-" & Site
    
    Dim xlSheet As Excel.Worksheet
    Dim x As Integer
    Dim y As Integer
    Dim j As Long
    Dim k As Long
        
    Set objexcelapp = CreateObject("Excel.Application")
    
    objexcelapp.workbooks.Open _
    "C:\data\book1.xls"
    objexcelapp.Visible = True
    
    Set xlSheet = activesheet
    
    'Insert 4 rows
    objexcelapp.Rows("1:1").Select
    objexcelapp.Selection.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    objexcelapp.Selection.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    objexcelapp.Selection.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    objexcelapp.Selection.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    
    'Insert 2 columns
    objexcelapp.Columns("A:A").Select
    objexcelapp.Selection.Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    objexcelapp.Selection.Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
    'Copy Contract # & Site to header
    objexcelapp.Range("C5").Select
    objexcelapp.Selection.copy
    objexcelapp.Range("A2").Select
    objexcelapp.activesheet.paste
    objexcelapp.Application.CutCopyMode = False
    objexcelapp.Range("D5").Select
    objexcelapp.Selection.copy
    objexcelapp.Range("A3").Select
    objexcelapp.activesheet.paste
    objexcelapp.Application.CutCopyMode = False
    objexcelapp.Range("C6").Select
    objexcelapp.Selection.copy
    objexcelapp.Range("E2").Select
    objexcelapp.activesheet.paste
    objexcelapp.Application.CutCopyMode = False
    objexcelapp.Range("D6").Select
    objexcelapp.Selection.copy
    objexcelapp.Range("E3").Select
    objexcelapp.activesheet.paste
    objexcelapp.Application.CutCopyMode = False
    
    'Delete Contract # and site columns
    objexcelapp.Columns("B:D").Select
    objexcelapp.Selection.Delete shift:=xlToLeft
    
    'Delete RateCardType Heading
    objexcelapp.Range("b5").Clear
    
    'Make headings bold
    objexcelapp.Range("A2:B3").Select
    objexcelapp.Selection.Font.Bold = True
    objexcelapp.Selection.Font.ColorIndex = 2
    objexcelapp.Rows("5:5").Select
    objexcelapp.Selection.Font.Bold = True
    objexcelapp.Selection.Font.ColorIndex = 2
    
    j = objexcelapp.WorksheetFunction.CountIf(Columns("B:B"), "Core Fleet")
    k = objexcelapp.WorksheetFunction.CountIf(Columns("B:B"), "As Required")
    
    'Centre UM & Rate
    objexcelapp.Range("d5").Resize(j + k + 1, 2).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
        
    'Color background Blue
    objexcelapp.Cells.Select
    With Selection
        .Interior.Color = 12611584
        .Font.Name = "arial"
    End With
       
    'Colour table background yellow & white
    x = 2
    For y = 6 To (j + k + 5)
        objexcelapp.Cells(y, x).Select
        With Selection
            .Interior.ColorIndex = 1
            .Font.ColorIndex = 2
        End With
        
        objexcelapp.Cells(y, x + 1).Select
        With Selection
            .Interior.ColorIndex = 36
        End With
        
        objexcelapp.Cells(y, x + 2).Select
        With Selection
            .Interior.ColorIndex = 2
        End With
        objexcelapp.Cells(y, x + 3).Select
        With Selection
            .Interior.ColorIndex = 2
        End With
    Next y
    
    'Colour headings black
    objexcelapp.Range("A2:B3").Select
    With Selection
        .Interior.ColorIndex = 1
    End With
    objexcelapp.Range("B5:E5").Select
    With Selection
        .Interior.ColorIndex = 1
    End With
  
    objexcelapp.Range("B6:E6").Offset(j, 0).Select
    objexcelapp.Selection.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    objexcelapp.Range("B6:E6").Offset(j, 0).Select
    With Selection
        .Interior.Color = 12611584
    End With
    
    'Borders
    objexcelapp.Range("A2:B3").Select
    objexcelapp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    objexcelapp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Color = -16776961
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = -16776961
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = -16776961
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Color = -16776961
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    
    objexcelapp.Range("B5:E5").Resize(j + 1, 4).Select
    objexcelapp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    objexcelapp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Color = 1
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = 1
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = 1
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Color = 1
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    
    objexcelapp.Range("b5:e5").Offset(j + 2, 0).Select
    objexcelapp.Selection.Resize(k, 4).Select
    objexcelapp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    objexcelapp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Color = 1
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = 1
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = 1
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Color = 1
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    
    'Column Borders
    objexcelapp.Range("B5").Resize(j + 1, 1).Select
    objexcelapp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    objexcelapp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Color = -16777215
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = -16777215
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = -16777215
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    objexcelapp.Selection.Offset(0, 1).Select
    objexcelapp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    objexcelapp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = -16777215
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = -16777215
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    objexcelapp.Selection.Offset(0, 1).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = -16777215
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = -16777215
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    objexcelapp.Range("B5:e5").Offset(j + 2, 0).Select
    objexcelapp.Selection.Resize(k, 1).Select
    objexcelapp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    objexcelapp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Color = -16777215
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = -16777215
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = -16777215
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    objexcelapp.Selection.Offset(0, 1).Select
    objexcelapp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    objexcelapp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = -16777215
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = -16777215
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    objexcelapp.Selection.Offset(0, 1).Select
    objexcelapp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    objexcelapp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = -16777215
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = -16777215
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
       
    'Merge Type
    objexcelapp.Range("B6").Resize(j, 1).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.Font.Bold = True
    
    objexcelapp.Range("B6").Offset(2, 0).Select
    objexcelapp.Selection.Resize(k, 1).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.Font.Bold = True
    
    'Change rate to currency
    objexcelapp.Range("e6").Resize(j, 1).Select
    objexcelapp.Selection.Style = "Currency"
    
    objexcelapp.Range("e6").Offset(j + 1).Select
    objexcelapp.Selection.Resize(k, 1).Select
    objexcelapp.Selection.Style = "Currency"
    objexcelapp.Columns("A:E").entirecolumn.AutoFit
    
'Exit_CmdRateCardExport_Click:
'    Exit Sub
'Err_CmdRateCardExport_Click:
'    MsgBox Err.Description
'    Resume Exit_CmdRateCardExport_Click
    
End Sub
 
I don't know why it hangs on that line, but I can't see that you don't realece the object "objexcelapp" when the sub finish.

Try and put this at the end of yor code

Set objexcelapp = Nothing

Hanging objects i memory can cause strange behavior.

JR
 
You must log in or register to reply here.

Similar threads

Z
Attempts to make my code more efficient don't work
Replies
5
Views
603
Zedster
Z
L
Retrieve excel from access (vol 4) , extended format , alternative color
Replies
7
Views
1,017
arnelgp
arnelgp
G
Extract correct leave time
Replies
2
Views
736
goncalo
G
B
Solved VBA code which exports data from Access to Excel and then loops through the Excel file
Replies
0
Views
820
BlueFllame
B
P
Export to Excel not working after SetAccessWindow code
Replies
4
Views
1,327
isladogs
isladogs

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom