• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 363
  • Last Modified:

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

0
bsncp
Asked:
bsncp
2 Solutions
 
Rob HensonFinance AnalystCommented:
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
1
 
byundtCommented:
I don't know anything about Access, but I am concerned that statement 25 has an unqualified reference to Range in the destination. Does this do any better?
objExcel.Selection.AutoFill Destination:=objExcel.Range("H2:H" & (iRows + 1))

Open in new window

0
 
Wayne Taylor (webtubbs)Commented:
I think Brad has it. Ideally though you would use objExcelSheet instead of the Excel application object.
0
 
bsncpAuthor Commented:
Thank you all for your replies.  I used objExcelSheet.Range and the code is running properly.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Introducing Cloud Class® training courses

Tech changes fast. You can learn faster. That’s why we’re bringing professional training courses to Experts Exchange. With a subscription, you can access all the Cloud Class® courses to expand your education, prep for certifications, and get top-notch instructions.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now