Hello everyone! I am a pretty beginner vba user and having some trouble getting a loop to work. I have a pretty extensive formatting code here, which works perfectly on a single worksheet. When I then try to have it loop through every single worksheet in the workbook except for the "Original" tab, it either doesn't work properly, or crashes and shuts down. My first thought is that perhaps it is the size of my workbook, which ends up having around 300 worksheets in it. Any advice or tips would be greatly appreciated as I am new to loops in general. Thanks so much!!
Code:
My loop code:
Sub Format()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim ws as worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Original" Then
*****My format code is here******
End If
Next ws
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End sub
The format code is below. This is the section that works on a run through a single worksheet, but not within the loop. Apologies for posting the full macro here but I'm just hoping I've goofed something in it which explains why it won't work:
'Plan Name
Rows("1:3").Select
Selection.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B5").Copy
Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'Delete unneccesary columns
Columns("A:E").Delete shift:=xlToLeft
Columns("A:E").EntireColumn.AutoFit
Columns("B:D").Delete shift:=xlToLeft
Columns("F:F").Delete shift:=xlToLeft
Columns("G:G").Delete shift:=xlToLeft
Columns("F:F").Select
Selection.Cut
Columns("I:I").Select
Selection.Insert shift:=xlToRight
Columns("C:C").Delete shift:=xlToLeft
Columns("D:D").Delete shift:=xlToLeft
'Delete Paying Agent Rows Using Column D
Last = Cells(Rows.Count, "D").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "D").Value) = "Paying Agent" Then
Cells(i, "A").EntireRow.Delete
End If
Next i
'Format Styles and Enter Headers
Columns("C:C").Select
Selection.Delete shift:=xlToLeft
Columns("E:E").Select
Selection.Cut
Columns("C:C").Select
Selection.Insert shift:=xlToRight
Columns("D:D").EntireColumn.AutoFit
Rows("5:5").Select
Selection.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A4").Select
ActiveCell.FormulaR1C1 = "Category"
Range("B4").Select
ActiveCell.FormulaR1C1 = "Paid By"
Range("E4").Select
ActiveCell.FormulaR1C1 = "Allocation Basis"
Range("F4").Select
ActiveCell.FormulaR1C1 = "Description"
Range("A2:F2").Select
Selection.Style = "Heading 1"
Rows("2:2").EntireRow.AutoFit
Range("A4:F4").Select
Selection.Style = "Heading 4"
Columns("F:F").ColumnWidth = 54.57
'Amount Value Formulas
'Formula MID(E6,SEARCH("$",E6),SEARCH("e",E6)-3) "=MID(E6,SEARCH(""$"",E6),SEARCH(""e"",E6)-3"
'Range("A1").Select
'Dim rng1 As Range, c1 As Range
'Set rng1 = Range("A5:A25")
' For Each c1 In rng1
'If InStr(1, c1.Value, "Accountholder Administration") > 0 Then c1.Offset(0, 2).Formula = "=RC[3]"
' Next
'LEFT(E7,SEARCH("of",E7)-2)
Range("A1").Select
Dim rnga As Range, ca As Range
Set rnga = Range("A5:A25")
For Each ca In rnga
If InStr(1, ca.Value, "Asset Support & Recordkeeping") > 0 Then ca.Offset(0, 2).Formula = "=LEFT(RC[2],SEARCH(""of"",RC[2])-2)"
Next
'LEFT(E8,SEARCH("of",E8)-2)
For Each ca In rnga
If InStr(1, ca.Value, "Investment Advisor Compensation") > 0 Then ca.Offset(0, 2).Formula = "=LEFT(RC[2],SEARCH(""of"",RC[2])-2)"
Next
For Each ca In rnga
If InStr(1, ca.Value, "Plan Administration") > 0 Then ca.Offset(0, 2).Formula = "=RC[2]"
Next
Columns("C:C").EntireColumn.AutoFit
Columns("C:C").Copy
Columns("C:C").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlRight
End With
Range("C4").HorizontalAlignment = xlLeft
Range("C4").Value = "Amount"
'HardCode Values Part 1
Dim rng As Range, c As Range
Set rng = Range("A5:A25")
For Each c In rng
If InStr(1, c.Value, "Accountholder Administration") > 0 Then c.Offset(0, 5).Value = "Ongoing support and compliance of participant activities"
Next
For Each c In rng
If InStr(1, c.Value, "Asset Support & Recordkeeping") > 0 Then c.Offset(0, 5).Value = "Recordkeeping, online account management, and benefit statements"
Next
For Each c In rng
If InStr(1, c.Value, "Investment Advisor Compensation") > 0 Then c.Offset(0, 5).Value = "Investment advisory services"
Next
For Each c In rng
If InStr(1, c.Value, "Plan Administration") > 0 Then c.Offset(0, 5).Value = "Annual government compliance testing and reporting"
Next
Columns("F:F").Copy
Columns("F:F").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'Allocation Basis Column
Columns("E:E").EntireColumn.AutoFit
Range("A1").Select
Dim rng2 As Range, c2 As Range
Set rng2 = Range("B6:B25")
For Each c2 In rng2
If InStr(1, c2.Value, "Plan") > 0 Then c2.Offset(0, 2).Value = "Paid by Participant, pro-rata on balances, quarterly in arrears"
Next
For Each c2 In rng2
If InStr(1, c2.Value, "Employer") > 0 Then c2.Offset(0, 2).Value = "Paid by Employer, quarterly in arrears"
Next
For Each c2 In rng2
If InStr(1, c2.Value, "Employer - Recurring") > 0 Then c2.Offset(0, 2).Value = "Paid by Employer, quarterly in arrears"
Next
Columns("E:E").Delete shift:=xlToLeft
Columns("D:D").EntireColumn.AutoFit
'HardCode Values Part 2
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.Value = "Custody"
Selection.Offset(0, 1).Formula = "=INDEX(A:B,MATCH(""Pass-through"",A:A,0),2)"
Selection.Offset(0, 2).Value = "6.5 Basis Points"
Selection.Offset(0, 3).Formula = "=IF(RC[-2]=""Plan"",""Deducted from Participant account, quarterly in arrears"",""Paid By Employer, quarterly in arrears"")"
Selection.Offset(0, 4).Value = "Holding of plan's financial assets"
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.Value = "Trading, Clearing, & Settlement"
Selection.Offset(0, 1).Formula = "=INDEX(A:B,MATCH(""Pass-through"",A:A,0),2)"
Selection.Offset(0, 2).Value = "0.07 Per Transaction"
Selection.Offset(0, 3).Formula = "=IF(RC[-2]=""Plan"",""Deducted from Participant account, quarterly in arrears"",""Paid By Employer, quarterly in arrears"")"
Selection.Offset(0, 4).Value = "Investment of the plan's financial assets"
Columns("B:D").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.Value = "Distribution"
Selection.Offset(0, 1).Value = "Participant"
Selection.Offset(0, 2).Value = "$75 Per Distribution"
Selection.Offset(0, 3).Value = "Deducted from Participant account"
Selection.Offset(0, 4).Value = "Distribution processing including tax form generation"
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.Value = "Inservice/Hardship"
Selection.Offset(0, 1).Value = "Participant"
Selection.Offset(0, 2).Value = "$85 Per Withdrawal"
Selection.Offset(0, 3).Value = "Deducted from Participant account"
Selection.Offset(0, 4).Value = "Hardship or Inservice withdrawal processing including tax form generation"
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.Value = "Loan Origination"
Selection.Offset(0, 1).Value = "Participant"
Selection.Offset(0, 2).Value = "$100 Per Loan"
Selection.Offset(0, 3).Value = "Deducted from Participant account"
Selection.Offset(0, 4).Value = "Loan Initiation and first year maintenance"
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.Value = "Loan Maintenance"
Selection.Offset(0, 1).Value = "Participant"
Selection.Offset(0, 2).Value = "$85 Per Loan"
Selection.Offset(0, 3).Value = "Deducted from Participant account"
Selection.Offset(0, 4).Value = "Ongoing loan maintenance, including loan repayment processing"
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.Value = "Participant QDRO"
Selection.Offset(0, 1).Value = "Participant"
Selection.Offset(0, 2).Value = "$150 Minimum"
Selection.Offset(0, 3).Value = "Deducted from Participant account"
Selection.Offset(0, 4).Value = "QDRO processing"
'Delete Pass-Through Rows Using Column A
Last1 = Cells(Rows.Count, "A").End(xlUp).Row
For i1 = Last1 To 1 Step -1
If (Cells(i1, "A").Value) = "Pass-through" Then
Cells(i1, "A").EntireRow.Delete
End If
Next i1
'Final Format
Columns("B:E").HorizontalAlignment = xlLeft
Columns("B:E").EntireColumn.AutoFit
Columns("C:C").NumberFormat = "$#,##0.00_);($#,##0.00)"
Range("A1").Select
Cells.Replace What:="Employer - Recurring", Replacement:="Employer", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
'Set Print Area
ActiveSheet.PageSetup.PrintArea = "$A$1:$F$25"
'Print Settings
With ActiveSheet.PageSetup
'.PrintTitleRows = "$3:$3"
'.PrintTitleColumns = "$B:$B"
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Last edited by a moderator: