Fixing Excel macro to count and summarize correct rows

Question

I have an excel document that initially has 1 tab like this:

When I run the "master" macro, it:

Deletes some columns
Adds a row at the top with numbers
Adds a blank sheet called Output
Takes the raw data tab, pastes it in the "output" tab and transposes it from wide to long (all those macros work perfectly)
Finally it counts chunks of rows in the output tab and inserts two rows with summary stats, like so:

So far, this is mostly the behavior I'd like. The 65 is in the correct spot. Id like it to show "91" right underneath that (the sum of the entire column so far), but at least the 65 is correct.

The more pressing problem is some of the following summary rows. For instance the very next summary rows have 91 where it should be, but an incorrect blank above it:

And then the following summary rows should be 100,100 and instead it says 0,91:

and the summary row after that should be 100,100 but is 0,191!

I'm less familiar pasting excel VBA onto stack (usually on the R side of things), but I think the problem is somewhere in this macro:

'ADD THE EXCEL FORMATTING********************************************************************
Sub format()
Dim lastRow As Long, rawRow As Long, rawCol As Long, writeRow As Long
'count total number of rows
lastRow = Sheets("Output").Cells(Rows.Count, 1).End(xlUp).Row

    'set starting places, first row with info is 3 while trouble shooting but 2 normally
        x = 1
        Row = 2
    'Set sum counter to add up all no cost center values
        total_RE_sum = 0 'total research effort actual
        total_REp_sum = 0 'total research effort previous
        total_REb_sum = 0 'total research effort budgeted
        total_E_sum = 0 'total effort actual
        total_Ep_sum = 0 'total effort previous
        total_Eb_sum = 0 'total effort budgeted
       
        'Start loop*****************************************************************************
        'where it finds ROW = 20 inserts 2 rows below
        For x = 1 To lastRow
        'For x = 1 To 66
            If Cells(Row, 11) = 20 Then
                Rows(Row + 1).EntireRow.Insert
                Rows(Row + 1).EntireRow.Insert
                
               ' Cells(Row + 1, 8).NumberFormat = "0%"
               ' Cells(Row + 1, 9).NumberFormat = "0%"
               ' Cells(Row + 1, 10).NumberFormat = "0%"
               ' Cells(Row + 2, 8).NumberFormat = "0%"
               ' Cells(Row + 2, 9).NumberFormat = "0%"
               ' Cells(Row + 2, 10).NumberFormat = "0%"
                Cells(Row + 1, 7) = "Total Research Effort"
                Cells(Row + 2, 7) = "Total Effort"
                ' insert reseach effort previous and actual
                Cells(Row + 1, 8) = total_REb_sum
                Cells(Row + 1, 9) = total_REp_sum
                Cells(Row + 1, 10) = total_RE_sum
                ' insert total effort previous and actual
                Cells(Row + 2, 8) = total_Eb_sum
                Cells(Row + 2, 9) = total_Ep_sum
                Cells(Row + 2, 10) = total_Ep_sum
                
                '2 rows are added in this step because the new row jsut added in this step adds to the increment
                Row = Row + 2
                'reset sum to 0 because I moved to a new person
                total_RE_sum = 0 'total research effort actual
                total_REp_sum = 0 'total research effort previous
                total_REb_sum = 0 'total research effort budgeted
                total_E_sum = 0 'total effort actual
                total_Ep_sum = 0 'total effort previous
                total_Eb_sum = 0 'total effort budgeted
            ElseIf Row >= 7 And Row <= 20 Then
                total_RE_sum = total_RE_sum + Cells(Row, 10).Value 'total research effort actual
                total_REp_sum = total_REp_sum + Cells(Row, 9).Value 'total research effort previous
                total_REb_sum = total_REb_sum + Cells(Row, 8).Value 'total research effort budgeted
                total_E_sum = total_E_sum + Cells(Row, 10).Value 'total effort actual
                total_Ep_sum = total_Ep_sum + Cells(Row, 9).Value 'total effort previous
                total_Eb_sum = total_Eb_sum + Cells(Row, 8).Value 'total effort budgeted
                Row = Row + 1
            Else
                total_E_sum = total_E_sum + Cells(Row, 10).Value 'total effort actual
                total_Ep_sum = total_Ep_sum + Cells(Row, 9).Value 'total effort previous
                total_Eb_sum = total_Eb_sum + Cells(Row, 8).Value 'total effort budgeted
                Row = Row + 1
            End If
             
            Next

End Sub

I'm not sure at all where the macro went wrong, I wasn't the original author. Thank you!

Sgdva · Accepted Answer

Notes:
I am only appending for the solution looked as stated,on a personal note I think the whole logic needs to be revised. The problem stated could be better worded for others to understand the logic without the need of downloading the file. In relation to selections used in the pre process look at this topic to avoid selection. Bottom line: You are right, the module format is the one needed to be fixed, I changed the whole logic for it
Demo:

Code:

Sub format_alternative()
Const NumRowsToAppend As Long = 20
Dim NumTotalRows As Long
Dim TotalCyclesToPerfom As Long
Dim CounterCyclesToPerform As Long
Dim NumRowsAppended As Long
Dim IsFixLast As Boolean
Dim NumRowResearchEffort As Long
Dim NumRowTotalEffort As Long
    With Sheets("Output")
    NumTotalRows = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
    TotalCyclesToPerfom = NumTotalRows / NumRowsToAppend
    'It means for last cycle there are not enough rows to do it as for others, so we need to append for that
    IsFixLast = IIf(NumTotalRows Mod NumRowsToAppend <> 0, True, False)
    NumRowsAppended = 1
    For CounterCyclesToPerform = 1 To TotalCyclesToPerfom
    If CounterCyclesToPerform = TotalCyclesToPerfom And IsFixLast = True Then ' 1. If CounterCyclesToPerform = TotalCyclesToPerfom And IsFixLast = True
    'I'm going to leave this scenario for you to try to understand the logic and when it happens you fix it accordingly
    
    Else ' 1. If CounterCyclesToPerform = TotalCyclesToPerfom And IsFixLast = True
    NumRowResearchEffort = (NumRowsToAppend * CounterCyclesToPerform) + 1 + NumRowsAppended
    NumRowTotalEffort = (NumRowsToAppend * CounterCyclesToPerform) + 2 + NumRowsAppended
    End If ' 1. If CounterCyclesToPerform = TotalCyclesToPerfom And IsFixLast = True
    .Rows(NumRowResearchEffort & ":" & NumRowTotalEffort).Insert
    .Cells(NumRowResearchEffort, 7) = "Total Research Effort"
    .Cells(NumRowTotalEffort, 7) = "Total Effort"
    ' insert reseach effort previous and actual. I changed for a formula so it's easier for the user to see what's going on calculations
    .Cells(NumRowResearchEffort, 8).Formula = "=SUM(H" & NumRowResearchEffort - 11 & ":H" & NumRowResearchEffort - 1 & ")"
    .Cells(NumRowResearchEffort, 9).Formula = "=SUM(I" & NumRowResearchEffort - 11 & ":I" & NumRowResearchEffort - 1 & ")"
    .Cells(NumRowResearchEffort, 10).Formula = "=SUM(J" & NumRowResearchEffort - 11 & ":J" & NumRowResearchEffort - 1 & ")"
    ' insert total effort previous and actual. I changed for a formula so it's easier for the user to see what's going on calculations
    .Cells(NumRowTotalEffort, 8).Formula = "=SUM(H" & NumRowResearchEffort - NumRowsToAppend & ":H" & NumRowResearchEffort - 1 & ")"
    .Cells(NumRowTotalEffort, 9).Formula = "=SUM(I" & NumRowResearchEffort - NumRowsToAppend & ":I" & NumRowResearchEffort - 1 & ")"
    .Cells(NumRowTotalEffort, 10).Formula = "=SUM(J" & NumRowResearchEffort - NumRowsToAppend & ":J" & NumRowResearchEffort - 1 & ")"
    NumRowsAppended = NumRowsAppended + 2
    Next CounterCyclesToPerform
    End With
End Sub

Fixing Excel macro to count and summarize correct rows

Answers (1)

Related Questions