Results 1 to 2 of 2

Thread: Loop through spreadsheet and replace static subtotals with formula
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Jun 2010
    Posts
    7
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Loop through spreadsheet and replace static subtotals with formula

    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 by pr3ach3r; Aug 21st, 2019 at 03:31 PM. Reason: correction

  2. #2
    New Member
    Join Date
    Jun 2010
    Posts
    7
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Loop through spreadsheet and replace static subtotals with formula

    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



    Quote Originally Posted by pr3ach3r View Post
    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

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •