Link to home
Start Free TrialLog in
Avatar of bsncp
bsncpFlag for Afghanistan

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

Open in new window

Avatar of Rob Henson
Rob Henson
Flag of United Kingdom of Great Britain and Northern Ireland image

Can I suggest you put a Stop command just before Line 25 to see what value it is assigning to the variable iRows.

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
ASKER CERTIFIED SOLUTION
Avatar of byundt
byundt
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of bsncp

ASKER

Thank you all for your replies.  I used objExcelSheet.Range and the code is running properly.