Reputation: 115
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
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
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