Hello,
I have a code below that will find changes in column J and will insert a blank row after the change.
My issue is that when I continue with the rest of the code, it will leave the last row as blank instead of adding a footer with the header and formatting needed.
I have data in columns J to Q. The change in value we are looking at is in column J. Once I change in value is found, the macro should insert a blank row afterwards, then it should add specific border to columns J:P, highlight J:Q a specific color, and finally add the footer title.
For example, this would be the original data in column J:
Apple
Apple
Apple
Banana
Banana
Banana
Banana
Cherry
Cherry
Cherry
Cherry
Cherry
Mango
Mango
The end result should be:
Apple
Apple
Apple
Apple Total
Banana
Banana
Banana
Banana
Banana Total
Cherry
Cherry
Cherry
Cherry
Cherry
Cherry Total
Mango
Mango
Mango Total
However, for some reason I am not getting "Mango Total". What am I missing in my code?
Thank you
I have a code below that will find changes in column J and will insert a blank row after the change.
My issue is that when I continue with the rest of the code, it will leave the last row as blank instead of adding a footer with the header and formatting needed.
I have data in columns J to Q. The change in value we are looking at is in column J. Once I change in value is found, the macro should insert a blank row afterwards, then it should add specific border to columns J:P, highlight J:Q a specific color, and finally add the footer title.
For example, this would be the original data in column J:
Apple
Apple
Apple
Banana
Banana
Banana
Banana
Cherry
Cherry
Cherry
Cherry
Cherry
Mango
Mango
The end result should be:
Apple
Apple
Apple
Apple Total
Banana
Banana
Banana
Banana
Banana Total
Cherry
Cherry
Cherry
Cherry
Cherry
Cherry Total
Mango
Mango
Mango Total
However, for some reason I am not getting "Mango Total". What am I missing in my code?
Code:
Sub Footer()
Dim lr As Long
Dim r2 As Long
Dim r3 As Long
Dim X As Long, LastRow As Long
Const DataCol As String = "J"
Const StartRow = 2
lr = Range("J" & Rows.Count).End(xlUp).Row
LastRow = Cells(Rows.Count, DataCol).End(xlUp).Row
'Compare the values in column J and insert footer when values are different
Application.ScreenUpdating = False
For X = LastRow To StartRow + 1 Step -1
If Cells(X, DataCol).Value <> Cells(X - 1, DataCol) Then Rows(X).Insert
Next
Application.ScreenUpdating = True
'Add specific border for footer
For r2 = 1 To lr
If Cells(r2, "J") = "" Then
Range(Cells(r2, "J"), Cells(r2, "P")).Select
With Selection
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
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
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
End If
Next r2
'Highlight footer
For r3 = 1 To lr
If Cells(r3, "J") = "" Then
Range(Cells(r3, "J"), Cells(r3, "Q")).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
End If
Next r3
'Add title to footer
Range("J1:J" & lr).SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C&"" Total"""
Selection.Font.Bold = True
Columns("J:J").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
Thank you