How to loop a macro with various length columns
Category: [Excel] Demo Available
How to loop a macro with various length columns
Requirement:
The user is new to writing macros so can only use record macro. It works but the user needs it to run through all the sheets in the workbook and adjust based on all different lengths of columns. The good thing is the column will always be K on every sheet.
Solution:
Try this macro: (Untested)
Code:
Sub InsertCol()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim LastRow As Long
For Each ws In Sheets
If ws.Name <> "Summary" Then
LastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
ws.Columns("K:K").Insert
ws.Range("K1").FormulaR1C1 = "Incurred Total Within Deductible"
ws.Range("K2").FormulaR1C1 = "=IF(RC[-1]<1000000,(RC[-1]),""1000000"")"
ws.Range("K2").AutoFill Destination:=ws.Range("K2:K" & LastRow), Type:=xlFillDefault
ws.Range("K" & LastRow + 1) = WorksheetFunction.Sum(ws.Range("K2:K" & LastRow))
ws.Range("K" & LastRow + 2) = ws.Range("K" & LastRow + 1).Value * 0.1
ws.Range("K" & LastRow + 3) = WorksheetFunction.Sum(ws.Range("K" & LastRow + 1) + Range("K" & LastRow + 2))
ws.Range("K" & LastRow + 1 & ":K" & LastRow + 3).NumberFormat = "#,##0.00"
ws.Range("L" & LastRow + 1) = "Sub Total "
ws.Range("L" & LastRow + 2) = "LCF @ 10% of Subtotal above"
ws.Range("L" & LastRow + 3) = "Total Incurred Within Deductible"
Sheets("Summary").Cells(Sheets("Summary").Rows.Count, "A").End(xlUp).Offset(1, 0) = ws.Name
Sheets("Summary").Cells(Sheets("Summary").Rows.Count, "B").End(xlUp).Offset(1, 0) = ws.Range("K" & LastRow + 1)
Sheets("Summary").Cells(Sheets("Summary").Rows.Count, "C").End(xlUp).Offset(1, 0) = ws.Range("K" & LastRow + 2)
Sheets("Summary").Cells(Sheets("Summary").Rows.Count, "D").End(xlUp).Offset(1, 0) = ws.Range("K" & LastRow + 3)
End If
Next ws
Application.ScreenUpdating = True
End Sub
Please note that the macro uses the sheet name "Summary".The user has found that the code 'works amazing but it needs one more small change. The formula isn't working for Grand Total aka 'Total incurred within deductible'. Sometimes is just shows the Sub Total and other times I don't know where it's getting the number from. Can you make that adjustment?'
Mumps replied:
Replace this line of code:
with this line:
Code:
ws.Range("K" & LastRow + 3) = WorksheetFunction.Sum(ws.Range("K" & LastRow + 1) + Range("K" & LastRow + 2))
Code:
ws.Range("K" & LastRow + 3) = WorksheetFunction.Sum(ws.Range("K" & LastRow + 1) + ws.Range("K" & LastRow + 2))
Obtained from the OzGrid Help Forum.
Solution provided by Mumps.
See also: Index to Excel VBA Code and Index to Excel Freebies and Lesson 1 - Excel Fundamentals and Index to how to… providing a range of solutions and Index to new resources and reference sheets
See also:
| How to change reference columns in another worksheet using VBA looping |
| How to loop each row if there is data after green colour cell then delete |
| How to loop each row if there is data after green colour cell then delete |
| How to integrate a formula within a loop |
Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.