MrLockett
MrLockett

Reputation: 115

Multiple Worksheets with Vlookup to Multiple Worksheets Macro too long

I am getting an error when I copy this macro to different worksheets in the same workbook.

For Example, when I copy this code for the worksheet "Class 11" and rename it to "Class 16" by doing a find and replace all from Class 11 to Class 16 and paste it in the vba, and do this for all the worksheets, so "Class 16", "Class 81", etc. I get an error that the macro is too long.

I want the macro to do the same thing but over the course of 71 worksheets in the same workbook and doing vlookups to over 71 worksheets in a different workbook.

Sub MonthlySKUAudit()
'
' MonthlySKUAudit Macro
'

'
'Class 11'

Sheets("Class 11").Select

    Columns("W:W").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("W1").Select
    ActiveCell.FormulaR1C1 = "Service Code"
    Range("W1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("W2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,13,False)"
    lastrow = Range("A65536").End(xlUp).Row
    Range("W2").AutoFill Destination:=Range("W2:W" & lastrow)
    Columns("W:W").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("V:W").Select
    Range("W1").Activate
    Selection.RowDifferences(ActiveCell).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
    Range("W1").Select
    Columns("X:X").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("X1").Select
    ActiveCell.FormulaR1C1 = "Return Program"
    Range("X1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("X2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,4,False)"
    lastrow = Range("A65536").End(xlUp).Row
    Range("X2").AutoFill Destination:=Range("X2:X" & lastrow)
    Columns("X:X").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("AA:AA").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AA1").Select
    ActiveCell.FormulaR1C1 = "Openbox Return"
    Range("AA1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("AA2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,9,False)"
    lastrow = Range("A65536").End(xlUp).Row
    Range("AA2").AutoFill Destination:=Range("AA2:AA" & lastrow)
    Columns("AA:AA").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("AE:AE").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AE1").Select
    ActiveCell.FormulaR1C1 = "Func Check"
    Range("AE1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("AE2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,10,False)"
    lastrow = Range("A65536").End(xlUp).Row
    Range("AE2").AutoFill Destination:=Range("AE2:AE" & lastrow)
    Columns("AE:AE").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("AG:AG").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AG1").Select
    ActiveCell.FormulaR1C1 = "Serial Number"
    Range("AG1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("AG2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,11,False)"
    lastrow = Range("A65536").End(xlUp).Row
    Range("AG2").AutoFill Destination:=Range("AG2:AG" & lastrow)
    Columns("AG:AG").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("Y:Y").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("Y1").Select
    ActiveCell.FormulaR1C1 = "Known Restrictions"
    Range("Y1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("Y2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,7,False)"
    lastrow = Range("A65536").End(xlUp).Row
    Range("Y2").AutoFill Destination:=Range("Y2:Y" & lastrow)
        Columns("Y:Y").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("AK:AK").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AK1").Select
    ActiveCell.FormulaR1C1 = "Support Factory Warranty"
    Range("AK1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("AK2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,15,False)"
    lastrow = Range("A65536").End(xlUp).Row
    Range("AK2").AutoFill Destination:=Range("AK2:AK" & lastrow)
    Columns("AK:AK").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False 
    Columns("AM:AM").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AM1").Select
    ActiveCell.FormulaR1C1 = "Service Under Warranty"
    Range("AM1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("AM2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,16,False)"
    lastrow = Range("A65536").End(xlUp).Row
    Range("AM2").AutoFill Destination:=Range("AM2:AM" & lastrow)    
    Columns("AM:AM").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False    
    Columns("AO:AO").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AO1").Select
    ActiveCell.FormulaR1C1 = "Service Outside Warranty"
    Range("AO1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("AO2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,17,False)"
    lastrow = Range("A65536").End(xlUp).Row
    Range("AO2").AutoFill Destination:=Range("AO2:AO" & lastrow)
    Columns("AO:AO").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False    
    Columns("AR:AR").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AR1").Select
    ActiveCell.FormulaR1C1 = "Resell Indicator"
    Range("AR1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("AR2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,21,False)"
    lastrow = Range("A65536").End(xlUp).Row
    Range("AR2").AutoFill Destination:=Range("AR2:AR" & lastrow)    
    Columns("AR:AR").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False    
    Columns("AU:AU").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AU1").Select
    ActiveCell.FormulaR1C1 = "RTV Defective Days"
    Range("AU1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("AU2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,20,False)"
    lastrow = Range("A65536").End(xlUp).Row
    Range("AU2").AutoFill Destination:=Range("AU2:AU" & lastrow)
    Columns("AU:AU").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False    
    Columns("AW:AW").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AW1").Select
    ActiveCell.FormulaR1C1 = "RTV Open Box Days"
    Range("AW1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("AW2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,19,False)"
    lastrow = Range("A65536").End(xlUp).Row
    Range("AW2").AutoFill Destination:=Range("AW2:AW" & lastrow)    
    Columns("AW:AW").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False    
    Columns("AY:AY").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AY1").Select
    ActiveCell.FormulaR1C1 = "Open Box Resell"
    Range("AY1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("AY2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,22,False)"
    lastrow = Range("A65536").End(xlUp).Row
    Range("AY2").AutoFill Destination:=Range("AY2:AY" & lastrow)

    Columns("AY:AY").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False    
    Columns("BB:BB").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("BB1").Select
    ActiveCell.FormulaR1C1 = "Liquidation"
    Range("BB1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("BB2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,24,False)"
    lastrow = Range("A65536").End(xlUp).Row
    Range("BB2").AutoFill Destination:=Range("BB2:BB" & lastrow)

        Columns("BB:BB").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False    
    Columns("BE:BE").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("BE1").Select
    ActiveCell.FormulaR1C1 = "Shelf Display to OB Resell"
    Range("BE1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("BE2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,23,False)"
    lastrow = Range("A65536").End(xlUp).Row
    Range("BE2").AutoFill Destination:=Range("BE2:BE" & lastrow)

        Columns("BE:BE").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    Columns("AA:AB").Select
    Range("AB1").Activate
    Selection.RowDifferences(ActiveCell).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
    Range("AB1").Select

        Columns("AE:AF").Select
    Range("AF1").Activate
    Selection.RowDifferences(ActiveCell).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
    Range("AF1").Select

          Columns("AG:AH").Select
    Range("AH1").Activate
    Selection.RowDifferences(ActiveCell).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
    Range("AH1").Select

             Columns("AJ:AK").Select
    Range("AK1").Activate
    Selection.RowDifferences(ActiveCell).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
    Range("AK1").Select

          Columns("AL:AM").Select
    Range("AM1").Activate
    Selection.RowDifferences(ActiveCell).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
    Range("AM1").Select

       Columns("AN:AO").Select
    Range("AO1").Activate
    Selection.RowDifferences(ActiveCell).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
    Range("AO1").Select

       Columns("AQ:AR").Select
    Range("AR1").Activate
    Selection.RowDifferences(ActiveCell).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
    Range("AR1").Select

     Columns("AT:AU").Select
    Range("AU1").Activate
    Selection.RowDifferences(ActiveCell).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
    Range("AU1").Select

    Columns("AV:AW").Select
    Range("AW1").Activate
    Selection.RowDifferences(ActiveCell).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
    Range("AW1").Select

      Columns("AX:AY").Select
    Range("AY1").Activate
    Selection.RowDifferences(ActiveCell).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
    Range("AY1").Select

       Columns("BA:BB").Select
    Range("BB1").Activate
    Selection.RowDifferences(ActiveCell).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
    Range("BB1").Select

    Columns("BD:BE").Select
    Range("BE1").Activate
    Selection.RowDifferences(ActiveCell).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
    Range("BE1").Select

    Rows("1:1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("AA:AA").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AA1").Select
    ActiveCell.FormulaR1C1 = "Returnable"
    Range("AA1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("AA2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,8,False)"
    lastrow = Range("A65536").End(xlUp).Row
    Range("AA2").AutoFill Destination:=Range("AA2:AA" & lastrow)
    Columns("AA:AA").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("Z:AA").Select
    Range("AA1").Activate
    Selection.RowDifferences(ActiveCell).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
    Range("AA1").Select

End Sub

Upvotes: 2

Views: 204

Answers (2)

user4039065
user4039065

Reputation:

Loops are your friend

You have many sequential processes where only one to three factors differ between up to sixteen repeated command sections.

Construct an array of the variables that change from one iteration to another and loop through the array, passing a new set of vars into the basic commands with each pass. This can be done to loop through worksheets, columns on a worksheet or even individual cells. The scope of each loop through an array is dictated by the LBound and UBound functions.

Essentially, I've broken your long-winded, step-by-step process down to a few loops. I've also broken out primary areas of concern into three sub procedures to localize them for individual attention.

1. main - Creates an array of the worksheet names to be processed and loops through the names, passing each in turn into the monthlySKUAudit as a parameter.
2. monthlySKUAudit - Takes the worksheet name passed to it and processes an individual worksheet by looping through arrays of columns and column-specific information.
3. makeLookGood - Moves some redundant formatting code to a 'helper' sub where minor inflections between uses are passed in as parameters.

Sub main()
    'main - loop through an array of worksheets and call monthlySKUAudit for each one
    Dim w As Long, vWSs As Variant

    'assign an array of worksheet names
    vWSs = Array("Class 11", "Class 16", "Class 81")

    For w = LBound(vWSs) To UBound(vWSs)
        Call monthlySKUAudit(strWS:=CStr(vWSs(w)))
    Next w

End Sub

Sub monthlySKUAudit(strWS As String)
    'monthlySKUAudit Macro - column/formula/insert/value and RowDifferences
    Dim rws As Long
    Dim c As Long, vCOLs As Variant

    With Worksheets(strWS)
        rws = .Cells(Rows.Count, 1).End(xlUp).Row - 1

        'form of <numerical column>, <vlookup return column>, <row 1 title>
        vCOLs = Array(Columns("W:W").Column, 13, "Service Code", _
                      Columns("X:X").Column, 4, "Return Program", _
                      Columns("AA:AA").Column, 9, "Openbox Return", _
                      Columns("AE:AE").Column, 10, "Func Check", _
                      Columns("AG:AG").Column, 11, "Serial Number", _
                      Columns("Y:Y").Column, 7, "Known Restrictions", _
                      Columns("AK:AK").Column, 15, "Support Factory Warranty", _
                      Columns("AM:AM").Column, 16, "Service Under Warranty", _
                      Columns("AO:AO").Column, 17, "Service Outside Warranty", _
                      Columns("AR:AR").Column, 21, "Resell Indicator", _
                      Columns("AU:AU").Column, 20, "RTV Defective Days", _
                      Columns("AW:AW").Column, 19, "RTV Open Box Days", _
                      Columns("AY:AY").Column, 22, "Open Box Resell", _
                      Columns("BB:BB").Column, 24, "Liquidation", _
                      Columns("BE:BE").Column, 23, "Shelf Display to OB Resell")

        'process the column inserts, yellow fill and row 1 column header labels
        For c = LBound(vCOLs) To UBound(vCOLs) Step 3
            .Columns(vCOLs(c)).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
            With .Columns(vCOLs(c))
                Call makeLookGood(.Cells(1), 65535, vCOLs(c + 2))
                .Cells(2).Resize(rws, 1).Formula = _
                    "=VLOOKUP(E2, '[Return Disposition Reference.xlsx]" & strWS & "'!$D:$AD, " & vCOLs(c + 1) & ", FALSE)"
                .Cells(2).Resize(rws, 1) = .Cells(2).Resize(rws, 1).Value
            End With
        Next c

        'form of <string columns>
        vCOLs = Array("V:W", "AA:AB", "AE:AF", "AG:AH", "AJ:AK", "AL:AM", _
                      "AN:AO", "AQ:AR", "AT:AU", "AV:AW", "AX:AY", "BA:BC", _
                      "BD:BE")

        'process all of the RowDifferences highlights
        For c = LBound(vCOLs) To UBound(vCOLs)
            With .Columns(vCOLs(c))
                Call makeLookGood(.Cells.RowDifferences(.Cells(1, 2)), 5287936)
            End With
        Next c

        'header row formatting
        With .Rows("1:1")
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .WrapText = True
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With

        'finish the oddball Insert & Formula left at the bottom
        .Columns("AA:AA").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        With .Columns("AA:AA")
            Call makeLookGood(.Cells(1), 65535, "Returnable")
            .Cells(2).Resize(rws, 1).Formula = _
                "=VLOOKUP(E2, '[Return Disposition Reference.xlsx]" & strWS & "'!$D:$AD, 8, FALSE)"
            .Cells(2).Resize(rws, 1) = .Cells(2).Resize(rws, 1).Value
        End With

        'finish the oddball RowDifferences left at the bottom
        With .Columns("Z:AA")
            Call makeLookGood(.Cells.RowDifferences(.Cells(1, 2)), 5287936)
        End With

    End With

End Sub

Sub makeLookGood(rng As Range, clr As Long, Optional lbl As Variant = "")
    'makeLookGood - interior fill and optional column header label
    With rng
        With .Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = clr
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        'if a column header label was passed in, use it
        If CBool(Len(CStr(lbl))) Then _
            .Cells(1) = lbl
    End With
End Sub

I am concerned with two areas but I did not change anything out of the order that you had originally. When inserting columns, it is best to work from right-to-left so that an inserted column does not change the order of subsequent column insertions. You can work left-to-right but you have to be careful to compensate for the fact that after inserting a column, you adjust subsequent work for the shift.

In at least two places, you start working in one direction and then stop and backtrack. Having never seen the actual data I cannot make definitive statements as you may have to backtrack in order to take advantage of recalculated data but in general it is better to work from one direction to another or base all column selection on the relative position of column header labels that do not change no matter what ordinal position they are in.

Your variable declarations¹ were lacking. Declare your variables as distinct types and assign them appropriate values.

I've also completely removed your reliance on .Select² and Activate² as a method of referencing cells while making good use of the With ... End With statement to facilitate direct worksheet/column/cell referencing. The ActiveWorkbook, ActiveSheet and ActiveCell properties are simply just not reliable methods of referencing an object to perform work on.

All-in-all, it didn't boil all the way down to a handful of code lines but it is certainly shorter (and to my eye more readable) than the original. An added bonus is that additions, deletions and modifications are performed once in a central location, not in dozens of virtually identical locales.


¹ Setting Require Variable Declaration within the VBE's Tools ► Options ► Editor property page will put the Option Explicit statement at the top of each newly created code sheet. This will avoid silly coding mistakes like misspellings as well as influencing you to use the correct variable type in the variable declaration. Variables created on-the-fly without declaration are all of the variant/object type. Using Option Explicit is widely considered 'best practice'.

² See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.

Upvotes: 1

Scott Craner
Scott Craner

Reputation: 152585

When doing the same thing over and over you want to do a loop. In this case I would do a For Each loop.

Also you want to avoid using .Select. See HERE for a great explanation of how to do this.

Combing the two I redid the first part of your code, column W:

Sub monthlyskuaudit()
Dim ws As Worksheet
Dim lastRow As Long
Dim cel As Range
Dim diffRng As Range
For Each ws In ActiveWorkbook.Sheets
    With ws
        lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        .Columns("W:W").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        With .Range("W1")
            .Value = "Service Code"
            .Interior.Color = 65535
        End With
        For Each cel In .Range("W2:W" & lastRow)
            cel.Value = ws.Evaluate("=VLOOKUP(E" & cel.Row & ",'V:\Return Disposition Reference\[Return Disposition Reference.xlsx]"& ws.Name & "'!$D:$AD,13,False)")
        Next cel
        Set diffRng = .Columns("V:W").RowDifferences(.Range("W1"))
        diffRng.Interior.Color = 5287936
        '...
    End With
Next ws
End Sub

This will iterate through each sheet and do the same thing over and over. Try to do the rest on your own. If you come into a specific problem come back with a more specific question.

Upvotes: 3

Related Questions