How can i make this tidier, the part where i change the colour of the cells towards the bottom, i am just repeating code, can I just select the desired ranges in one line?
Code
'clear contents of the unwanted subtotals
Dim Rng As Range, List As Object, Rw As Long
Set List = CreateObject("Scripting.Dictionary")
With Sheets("BC")
For Each Rng In .Range("B3", .Range("B" & Rows.Count).End(xlUp))
If Not List.Exists(Rng.Value) Then
List.Add Rng.Value, Nothing
End If
Next
End With
With Sheets("Summary")
For Rw = .Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
If List.Exists(.Cells(Rw, "A").Value) Then
.Cells(Rw, "B").ClearContents
.Cells(Rw, "C").ClearContents
.Cells(Rw, "D").ClearContents
'change format of headers to grey, change header fonts to bold
.Cells(Rw, "C").Select
With selection.Interior
.Pattern = xlSolid
.PatternThemeColor = xlThemeColorDark1
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = -0.149998474074526
End With
.Cells(Rw, "D").Select
With selection.Interior
.Pattern = xlSolid
.PatternThemeColor = xlThemeColorDark1
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = -0.149998474074526
.Cells(Rw, "E").Select
With selection.Interior
.Pattern = xlSolid
.PatternThemeColor = xlThemeColorDark1
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = -0.149998474074526
End With
Display More