Forum Discussion
Hannah365
Feb 10, 2022Copper Contributor
Macro for adding columns with variable rows
Hi! I am trying to create a macro that will subtotal columns I and L where column B contains the word "summary". is this possible?!?!?
Hannah365
Feb 10, 2022Copper Contributor
I think i got them a bit confused. i do want a subtotal but i want it to do it on the entire sheet when i run my macro. do i just copy and paste the formula you originally sent into my macro that has my other conditional formatting already?
HansVogelaar
Feb 10, 2022MVP
I'm confused now. Let's start from scratch: could you try to explain as clearly as you can what you want?
- Hannah365Feb 10, 2022Copper ContributorI'm Sorry!
Okay, i currently have a macro that takes a completely plain excel sheet and adds the colors and columns in the picture i attached above. The final thing i need this spreadsheet to do is to subtotal columns I and L on the rows that have "summary" as part of the content of column B. The number of rows will vary depending upon the job i run this macro on.
Is it possible to have these subtotals be a part of my current macro?- HansVogelaarFeb 10, 2022MVP
Ah, now I get it (I hope). Create the following macro and call it at the end of the existing macro:
Sub AddTotal() Dim rng As Range Dim adr As String Dim r1 As Long Dim r2 As Long r1 = 4 With Range("B:B") Set rng = .Find(What:="Summary", LookIn:=xlValues, LookAt:=xlPart) If Not rng Is Nothing Then adr = rng.Address Do r2 = rng.Row Range("I" & r2).Formula = "=SUM(I" & r1 & ":I" & r2 - 1 & ")" Range("L" & r2).Formula = "=SUM(L" & r1 & ":L" & r2 - 1 & ")" r1 = r2 + 1 Set rng = .FindNext(After:=rng) If rng Is Nothing Then Exit Do Loop Until rng.Address = adr End If End With End Sub- Hannah365Feb 10, 2022Copper ContributorOkay, this is what i have: keep getting errors. do you see anything that is wrong?
Sub CostToFinish4()
'
' CostToFinish4 Macro
'
'
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("I:I").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("L:L").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("I:I").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Columns("L:L").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Rows("1:1").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("A1:AA1").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.Font.Bold = True
Selection.Font.Size = 12
Selection.Font.Size = 14
Selection.Font.Size = 16
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A2:AA2").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 192
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A3:AA3").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.499984740745262
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("E12").Select
Columns("B:B").EntireColumn.AutoFit
Columns("A:A").ColumnWidth = 18.09
Cells.Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=LEFT($B1,7)=""Summary"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.499984740745262
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("B7").Select
ActiveWorkbook.Save
Sub AddTotal()
Dim rng As Range
Dim adr As String
Dim r1 As Long
Dim r2 As Long
r1 = 4
With Range("B:B")
Set rng = .Find(What:="Summary", LookIn:=xlValues, LookAt:=xlPart)
If Not rng Is Nothing Then
adr = rng.Address
Do
r2 = rng.Row
Range("I" & r2).Formula = "=SUM(I" & r1 & ":I" & r2 - 1 & ")"
Range("L" & r2).Formula = "=SUM(L" & r1 & ":L" & r2 - 1 & ")"
r1 = r2 + 1
Set rng = .FindNext(After:=rng)
If rng Is Nothing Then Exit Do
Loop Until rng.Address = adr
End If
End With
End Sub