Macro to add sum row

[HazatB]

Hello,

I have put together the following code for my table however I need to figure out how to include a SUM row at the bottom. Any assistance will be appreciated.


Workbooks.OpenText Filename:= _
"K:\1900\dwprod1900\data\export\general\before_n_after_remap_audit_umroi.txt", _
Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 2), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1)), _
TrailingMinusNumbers:=True
Windows("UMROI_Standard Cost Audit Reports.xlsm").Activate

Dim LastRow As Long

LastRow = Workbooks("before_n_after_remap_audit_umroi.txt").Worksheets("before_n_after_remap_audit_umro").Range("A:E").Find("*", , xlValues, xlPart, xlByRows, xlPrevious, False).Row
LastRow = Workbooks("before_n_after_remap_audit_umroi.txt").Worksheets("before_n_after_remap_audit_umro").Range("F:G").Find("*", , xlValues, xlPart, xlByRows, xlPrevious, False).Row
LastRow = Workbooks("UMROI_Standard Cost Audit Reports.xlsm").Worksheets("Before n After Remap Review").Range("A:E").Find("*", , xlValues, xlPart, xlByRows, xlPrevious, False).Row
LastRow = Workbooks("UMROI_Standard Cost Audit Reports.xlsm").Worksheets("Before n After Remap Review").Range("I:J").Find("*", , xlValues, xlPart, xlByRows, xlPrevious, False).Row

Worksheets("Before n After Remap Review").Range("A7:E" & LastRow).Select
Selection.ClearContents

Worksheets("Before n After Remap Review").Range("I7:J" & LastRow).Select
Selection.ClearContents

Workbooks("before_n_after_remap_audit_umroi.txt").Worksheets("before_n_after_remap_audit_umro").Range("A1:E" & LastRow).Copy
Workbooks("UMROI_Standard Cost Audit Reports.xlsm").Worksheets("Before n After Remap Review").Range("A7:E" & LastRow).PasteSpecial

Application.CutCopyMode = False

Workbooks("before_n_after_remap_audit_umroi.txt").Worksheets("before_n_after_remap_audit_umro").Range("F1:G" & LastRow).Copy
Workbooks("UMROI_Standard Cost Audit Reports.xlsm").Worksheets("Before n After Remap Review").Range("I7:J" & LastRow).PasteSpecial

Application.CutCopyMode = False

 

[JackDanIce]

Untested, try:

Sub SumLastRow()

    Dim LR      As Long
    Dim wks1    As Worksheet
    Dim wks2    As Worksheet
    
    Set wks2 = Workbooks("UMROI_Standard Cost Audit Reports.xlsm").Worksheets("Before n After Remap Review")
    
    Application.ScreenUpdating = False
    
    Workbooks.OpenText FileName:="K:\1900\dwprod1900\data\export\general\before_n_after_remap_audit_umroi.txt", _
        Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 2), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1)), TrailingMinusNumbers:=True
    
    Set wks1 = Workbooks("before_n_after_remap_audit_umroi.txt").Sheets(1)
    
    With wks2
        LR = .Cells.find("*", , xlValues, xlPart, xlByRows, xlPrevious).row
        .Range("A7:E" & LR & ",I7:J" & LR).ClearContents
    End With
    
    With wks1
        LR = .Cells.find("*", , xlValues, xlPart, xlByRows, xlPrevious).row
        wks2.Range("A7:E" & LR).Value = .Range("A7:E" & LR).Value
        wks2.Range("I7:J" & LR).Value = .Range("I7:J") & LR.Value
    End With
    
    With wks2
        With .Cells(LR + 1, 1)
            .Formula = "=SUM($A$7:$A$" & LR & ")"
            .Resize(, 10).FillRight
        End With
        .Calculate
        .Parent.Activate
    End With
    
    Application.ScreenUpdating = True
    
    Set wks1 = Nothing
    Set wks2 = Nothing
        
End Sub

 

[HazatB]

Thanks!
I tested it and did only a few adjustments and it worked nicely to sum the columns that I needed to total. The last thing I need to do to complete my project is to take those 2 of the totals rows and calculate the percentage with this if statement.

=IF($D6658=0,IF($F6658=0,0,IF($F6658<>0,1,$F6658/$D6658)),$F6658/$D6658) I just need this formula to be dynamic for that last row of totals. After that I will be in good shape

 

[JackDanIce]

Adjust for lines in blue:

    With wks2
        With .Cells(LR + 1, 1)
            .Formula = "=SUM($A$7:$A$" & LR & ")"
            .Offset(1).Formula = Replace("=IF($D@LR=0,IF($F6658=0,0,IF($F6658<>0,1,$F6658/$D6658)),$F6658/$D6658)", "@LR", LR)
            .Resize(2, 10).FillRight
        End With
        .Calculate
        .Parent.Activate
    End With

 

[JackDanIce]

Typo, use:

    With wks2
        With .Cells(LR + 1, 1)
            .Formula = "=SUM($A$7:$A$" & LR & ")"
            .Offset(1).Formula = Replace("=IF($D@LR=0,IF($F@LR=0,0,IF($F@LR<>0,1,$F@LR/$D@LR)),$F@LR/$D@LR)", "@LR", LR)
            .Resize(2, 10).FillRight
        End With
        .Calculate
        .Parent.Activate
    End With