bsncp
asked on
Visual Basic Excel Formatting error
For some reason, the code below regularly "crashes" at line 25 in the code below. I run the code in a module as part of a multi-step MS Access macro using the RunCode action. The code finds the file and does a bunch of formatting steps. I get a couple different error messages when I run the code...sometimes I get "Method Range of Object Global Failed" and sometimes it just says "The remote Server Machine does not Exist or is unavailable." Thanks in advance for suggestions!
Function ExcelLidsHardgoodsStudy()
'adds filtering, freezes panes, etc.
Dim objExcel As Object
Dim objExcelbook As Object
Dim objExcelSheet As Object
Dim objWindow As Object
Dim iRows As Long
Set objExcel = CreateObject("Excel.Application")
Set objExcelbook = objExcel.Workbooks.Open("P:\Sales_Dept\Field_Sales_Info\Lids\HardGoodsStudy.xlsx")
Set objExcelSheet = objExcel.ActiveSheet
Set objWindow = objExcel.ActiveWindow
iRows = objExcel.ActiveSheet.UsedRange.Rows.Count
objExcel.Visible = False
objExcel.Columns("H:H").Select
objExcel.Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
objExcel.Range("H1").Select
objExcel.ActiveCell.FormulaR1C1 = "% of Ttl"
objExcel.Range("H2").Select
objExcel.ActiveCell.FormulaR1C1 = "=RC[-1]/RC[-2]"
objExcel.Range("H2").Select
objExcel.Selection.AutoFill Destination:=Range("H2:H" & (iRows + 1))
objExcel.Range("H2:H182").Select
objExcel.Columns("J:J").Select
objExcel.Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
objExcel.Range("J1").Select
objExcel.ActiveCell.FormulaR1C1 = "% of Ttl"
objExcel.Range("J2").Select
objExcel.ActiveCell.FormulaR1C1 = "=RC[-1]/RC[-4]"
objExcel.Range("J2").Select
objExcel.Selection.AutoFill Destination:=Range("J2:J" & (iRows + 1))
objExcel.Range("J2:J182").Select
objExcel.Columns("K:K").Select
objExcel.Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
objExcel.Range("K1").Select
objExcel.ActiveCell.FormulaR1C1 = "HG % of Ttl"
objExcel.Range("K2").Select
objExcel.ActiveCell.FormulaR1C1 = "=(SUM(RC[-4],RC[-2])/RC[-5])"
objExcel.Range("K2").Select
objExcel.Selection.AutoFill Destination:=Range("K2:K" & (iRows + 1))
'Insert gray bar betweeen QTD and YTD
objExcel.Columns("L:L").Select
objExcel.Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
objExcel.Selection.ColumnWidth = 1.71
objExcel.Range("L1").Select
objExcel.Selection.Copy
objExcel.Range("L2").Select
objExcel.Range("L2:L" & (iRows + 1)).Select
objExcel.ActiveSheet.Paste
objExcel.Application.CutCopyMode = False
objExcel.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
objExcel.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
objExcel.Selection.Borders(xlEdgeLeft).LineStyle = xlNone
objExcel.Selection.Borders(xlEdgeBottom).LineStyle = xlNone
objExcel.Selection.Borders(xlEdgeRight).LineStyle = xlNone
objExcel.Selection.Borders(xlInsideVertical).LineStyle = xlNone
objExcel.Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Columns("O:O").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
objExcel.Range("O1").Select
objExcel.ActiveCell.FormulaR1C1 = "% of Ttl"
objExcel.Range("O2").Select
objExcel.ActiveCell.FormulaR1C1 = "=RC[-1]/RC[-2]"
objExcel.Range("O2").Select
objExcel.Selection.AutoFill Destination:=Range("O2:O" & (iRows + 1))
objExcel.Range("O2:O25").Select
objExcel.Range("P1").Select
objExcel.Selection.Copy
objExcel.Range("Q1").Select
objExcel.ActiveSheet.Paste
objExcel.Range("R1").Select
objExcel.ActiveSheet.Paste
objExcel.Range("Q1").Select
objExcel.Application.CutCopyMode = False
objExcel.ActiveCell.FormulaR1C1 = "% of Ttl"
objExcel.Range("Q2").Select
objExcel.ActiveCell.FormulaR1C1 = "=RC[-1]/RC[-4]"
objExcel.Range("Q2").Select
objExcel.Selection.AutoFill Destination:=Range("Q2:Q" & (iRows + 1))
objExcel.Range("Q2:Q25").Select
objExcel.Range("R1").Select
objExcel.ActiveCell.FormulaR1C1 = "HG % of Ttl"
objExcel.Range("R2").Select
objExcel.ActiveCell.FormulaR1C1 = "=(SUM(RC[-4],RC[-2])/RC[-5])"
objExcel.Range("R2").Select
objExcel.Selection.AutoFill Destination:=Range("R2:R" & (iRows + 1))
objExcel.Range("R2:R25").Select
objExcel.Range("R:R,Q:Q,O:O,J:J,K:K,H:H").Select
objExcel.Range("H1").Activate
objExcel.Selection.Style = "Percent"
objExcel.Range("F:F,G:G,I:I,M:M,N:N,P:P").Select
objExcel.Range("P1").Activate
objExcel.Selection.Style = "Currency"
objExcel.Selection.NumberFormat = "_($* #,##0.0_);_($* (#,##0.0);_($* ""-""??_);_(@_)"
objExcel.Selection.NumberFormat = "_($* #,##0_);_($* (#,##0);_($* ""-""??_);_(@_)"
objExcel.Range("A1").Select
objExcel.Range(Selection, Selection.End(xlDown)).Select
objExcel.Range(Selection, Selection.End(xlToRight)).Select
objExcel.Range(Selection, Selection.End(xlToRight)).Select
objExcel.Range(Selection, Selection.End(xlToRight)).Select
objExcel.Range(Selection, Selection.End(xlToLeft)).Select
objExcel.Range(Selection, Selection.End(xlToRight)).Select
objExcel.Cells.Select
objExcel.Selection.ColumnWidth = 90.86
objExcel.Cells.EntireColumn.AutoFit
objExcel.Cells.EntireRow.AutoFit
objExcel.Range("A1").Select
objExcel.Columns("L:L").ColumnWidth = 0.75
'Add subtotals
objExcel.Range("F2").Select
objExcel.Selection.End(xlDown).Select
objExcel.Range("F" & (iRows + 1)).Select
objExcel.ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[" & "-" & iRows & "]C:R[-1]C)"
objExcel.Range("G2").Select
objExcel.Selection.End(xlDown).Select
objExcel.Range("G" & (iRows + 1)).Select
objExcel.ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[" & "-" & iRows & "]C:R[-1]C)"
objExcel.Range("I2").Select
objExcel.Selection.End(xlDown).Select
objExcel.Range("I" & (iRows + 1)).Select
objExcel.ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[" & "-" & iRows & "]C:R[-1]C)"
objExcel.Range("M2").Select
objExcel.Selection.End(xlDown).Select
objExcel.Range("M" & (iRows + 1)).Select
objExcel.ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[" & "-" & iRows & "]C:R[-1]C)"
objExcel.Range("N2").Select
objExcel.Selection.End(xlDown).Select
objExcel.Range("N" & (iRows + 1)).Select
objExcel.ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[" & "-" & iRows & "]C:R[-1]C)"
objExcel.Range("P2").Select
objExcel.Selection.End(xlDown).Select
objExcel.Range("P" & (iRows + 1)).Select
objExcel.ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[" & "-" & iRows & "]C:R[-1]C)"
objExcel.Rows(iRows + 1 & ":" & iRows + 1).Select
objExcel.Selection.Font.Bold = True
'Insert row and add YTD and QTD header labels
objExcel.Rows("1:1").Select
objExcel.Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
objExcel.Range("F1:K1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
objExcel.Selection.Merge
objExcel.ActiveCell.FormulaR1C1 = "Calendar Year to Date"
objExcel.Range("M1:R1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
objExcel.Selection.Merge
objExcel.ActiveCell.FormulaR1C1 = "Quarter to Date"
objExcel.Range("F1:K1,M1:R1").Select
objExcel.Range("M1").Activate
objExcel.Selection.Font.Bold = True
objExcel.Rows("3:3").Select
objExcel.ActiveWindow.FreezePanes = True
objExcel.Cells.Select
With Selection.Font
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
End With
objExcel.Range("A2:R" & (iRows)).Select
objExcel.Selection.AutoFilter
objExcel.Range("A2").Select
objExcel.ActiveWorkbook.Save
objExcel.ActiveWorkbook.Close
objExcel.Quit
Set objWindow = Nothing
Set objExcelSheet = Nothing
Set objExcelbook = Nothing
Set objExcel = Nothing
End Function
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thank you all for your replies. I used objExcelSheet.Range and the code is running properly.
Then compare that to the true number of rows used in the Excel file.
It could be that the UsedRange of the Excel file is getting messed up.
Thanks
Rob H