Update cell range/reference in existing macro and exclude 1 row

lichldo

Board Regular
Joined
Apr 19, 2022
Messages
65
Office Version
  1. 365
Platform
  1. MacOS
Hello, I am trying to update a macro that someone else wrote and I cannot follow the logic. Currently this macro will total/format cells within defined sections of rows between columns I and O.

However, we have added a column and now we need the macro to change to do columns J to P instead. We would also like to EXCLUDE just row 2. Nothing else needs to change. Can anyone help? Here is the code -


VBA Code:
Sub Totals()
Dim i As Long
Dim lrow As Long
Dim PrevRow As Long
Dim j As Long

lrow = Cells(Rows.Count, 1).End(xlUp).Row
PrevRow = 1

For i = 2 To lrow + 1
    If Cells(i, 1) = "" Then
        Range("I" & i) = "=Sum(I" & PrevRow + 1 & ":I" & i - 1 & ")"
        Range("I" & i).Copy
        Range("J" & i & ":O" & i).PasteSpecial xlPasteFormulas
        Application.CutCopyMode = False
        
        PrevRow = i
        
        Range("I" & i & ":O" & i).Font.Color = 0
        Range("I" & i & ":O" & i).Font.Bold = True
        
        For j = 9 To 15
            If Cells(i, j) < 50000 Then Cells(i, j).Font.Color = -11489280 'Turn everything < 50k to green font
             If Cells(i, j) > 75000 Then Cells(i, j).Font.Color = -16776961 'Turn everything > 75k to red font
        Next j
          
    End If
       
Next i


End Sub
 
Last edited by a moderator:

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
How about
VBA Code:
Sub Totals()
Dim i As Long
Dim lrow As Long
Dim PrevRow As Long
Dim j As Long

lrow = Cells(Rows.Count, 1).End(xlUp).Row
PrevRow = 1

For i = 3 To lrow + 1
    If Cells(i, 1) = "" Then
        Range("J" & i) = "=Sum(J" & PrevRow + 1 & ":J" & i - 1 & ")"
        Range("J" & i).Copy
        Range("K" & i & ":P" & i).PasteSpecial xlPasteFormulas
        Application.CutCopyMode = False
        
        PrevRow = i
        
        Range("I" & i & ":O" & i).Font.Color = 0
        Range("I" & i & ":O" & i).Font.Bold = True
        
        For j = 10 To 16
            If Cells(i, j) < 50000 Then Cells(i, j).Font.Color = -11489280 'Turn everything < 50k to green font
             If Cells(i, j) > 75000 Then Cells(i, j).Font.Color = -16776961 'Turn everything > 75k to red font
        Next j
          
    End If
       
Next i


End Sub
In future when posting code please use code tags, it makes it a lot easier to read & understand the code. How to Post Your VBA Code
 
Upvote 0

Forum statistics

Threads
1,214,617
Messages
6,120,541
Members
448,970
Latest member
kennimack

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top