Loop through spreadsheet and replace static subtotals with formula

pr3ach3r

New Member
Joined
Jun 8, 2010
Messages
7
Hopefully this make sense.

I have this table I would like to loop through and change the subtotals to actual formulas.

https://imgur.com/YC0m2LP

My Thought was to loop through the A column because the subtotals are placed the row after the name. I thought if I could calculate the range between the last name I could use that to create a sum(). Any ideas on calculating that range?

The spreadsheet is much larger than that image.
Code:
Sub Cleanup()

countblank  'Function to get lastrow
      Dim x As Integer
      Dim CRng
      Application.ScreenUpdating = False
      ' Set numrows = number of rows of data.
      NumRows = ctblank
      ' Select cell a1.
      Range("A2").Select
      ' Establish "For" loop to loop "numrows" number of times.
      For x = 2 To NumRows
         If (Not IsEmpty(Cells(x, 1)) And Not ActiveCell.Row = 2) Then
       
            sRegion = Range(Cells(x, 2).Offset(1, 0).Address).CurrentRegion
         
         LRow = Cells(x, 2).Address
         MsgBox LRow & "-" & Cells(x, 2).Offset(1, 0).Address
         LRow = ""
         
         
         
         'ActiveCell.Offset(1, 3).Value = "=Sum(" & sRegion & ")"
       
        
       
         End If
         
         
         ActiveCell.Offset(1, 0).Select
      Next
      Application.ScreenUpdating = True
End Sub
 
Last edited:

Some videos you may like

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)

pr3ach3r

New Member
Joined
Jun 8, 2010
Messages
7
I think I figured it out with one exception:

The last row of subtotals it does not do that row.


Code:
Sub CleanupMasReport()

countblank  'Function to get lastrow
      Dim x As Integer
      Dim CRng
      Application.ScreenUpdating = False
      ' Set numrows = number of rows of data.
      NumRows = ctblank
      ' Select cell a1.
      Range("A2").Select
      'Cleanup zeros in report
      Range("A2").Select
      Cells.Replace What:="0", Replacement:="", LookAt:=xlWhole, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
      
      
      ' Establish "For" loop to loop "numrows" number of times.
      LRow = Cells(2, 3).Row
      For x = 3 To NumRows
         If (Not IsEmpty(Cells(x, 1)) And Not ActiveCell.Row = 2) Then
       
         
          ERow = Cells(x, 3).Offset(-1, 0).Row
         
           ActiveCell.Offset(2, 2).Formula = "=Sum(C" & LRow & ":" & "C" & ERow & ")"
           ActiveCell.Offset(2, 3).Formula = "=Sum(D" & LRow & ":" & "D" & ERow & ")"
           ActiveCell.Offset(2, 4).Formula = "=Sum(E" & LRow & ":" & "E" & ERow & ")"
           ActiveCell.Offset(2, 5).Formula = "=Sum(F" & LRow & ":" & "F" & ERow & ")"
           ActiveCell.Offset(2, 6).Formula = "=Sum(G" & LRow & ":" & "G" & ERow & ")"
           ActiveCell.Offset(2, 7).Formula = "=Sum(H" & LRow & ":" & "H" & ERow & ")"
           ActiveCell.Offset(2, 8).Formula = "=Sum(I" & LRow & ":" & "I" & ERow & ")"
           ActiveCell.Offset(2, 9).Formula = "=Sum(J" & LRow & ":" & "J" & ERow & ")"
           ActiveCell.Offset(2, 10).Formula = "=Sum(K" & LRow & ":" & "K" & ERow & ")"
           ActiveCell.Offset(2, 11).Formula = "=Sum(L" & LRow & ":" & "L" & ERow & ")"
           ActiveCell.Offset(2, 12).Formula = "=Sum(M" & LRow & ":" & "M" & ERow & ")"
           ActiveCell.Offset(2, 13).Formula = "=Sum(N" & LRow & ":" & "N" & ERow & ")"
           ActiveCell.Offset(2, 14).Formula = "=Sum(O" & LRow & ":" & "O" & ERow & ")"
           
            'MsgBox ActiveCell.Offset(2, 2).Address
            
          LRow = Cells(x + 1, 2).Row + 1
         
         
       
        
       
         End If
         
         
         ActiveCell.Offset(1, 0).Select
      Next
      MsgBox LRow
      Application.ScreenUpdating = True
End Sub



Hopefully this make sense.

I have this table I would like to loop through and change the subtotals to actual formulas.

https://imgur.com/YC0m2LP

My Thought was to loop through the A column because the subtotals are placed the row after the name. I thought if I could calculate the range between the last name I could use that to create a sum(). Any ideas on calculating that range?

The spreadsheet is much larger than that image.
Code:
Sub Cleanup()

countblank  'Function to get lastrow
      Dim x As Integer
      Dim CRng
      Application.ScreenUpdating = False
      ' Set numrows = number of rows of data.
      NumRows = ctblank
      ' Select cell a1.
      Range("A2").Select
      ' Establish "For" loop to loop "numrows" number of times.
      For x = 2 To NumRows
         If (Not IsEmpty(Cells(x, 1)) And Not ActiveCell.Row = 2) Then
       
            sRegion = Range(Cells(x, 2).Offset(1, 0).Address).CurrentRegion
         
         LRow = Cells(x, 2).Address
         MsgBox LRow & "-" & Cells(x, 2).Offset(1, 0).Address
         LRow = ""
         
         
         
         'ActiveCell.Offset(1, 3).Value = "=Sum(" & sRegion & ")"
       
        
       
         End If
         
         
         ActiveCell.Offset(1, 0).Select
      Next
      Application.ScreenUpdating = True
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,102,050
Messages
5,484,410
Members
407,438
Latest member
DKrakken

This Week's Hot Topics

  • Finding issue in If elseif else with For each Loop
    Finding issue in If elseif else with For each Loop I have tried this below code but i'm getting in Y column filled with W005. Colud you please...
  • MsgBox Error
    Hi Guys, I have the below error show up when i try and run my macro in File1 but works fine if i copy and paste the same code into file2. [ATTACH...
  • CELL FORMAT - IF CONDITION
    My Cell Format is [B]""0.00" Cr". [/B]But in the cell, it is showing 123.00 for editing. (123 is entry figure). (Data imported from other...
  • Show numbers nearly the same
    Is this possible. I have a number that can change very time eg 0.00001234 Then I have a lot of numbers 0.0000001, 0.0000002, 0.00000004...
  • Please i need your help to create formula
    I need a formula in cell B8 to do this >>if b1=1 then multiply ( cell b8) by 10% ,if b1=2 multiply by 20%,if=3 multiply by 30%. Thank you in...
  • Got error while adding column and filter
    Got error while adding column and filter In column Z has some like "Success" and "Error". I want to add column in AA if the Z cell value is...
Top