Forum Discussion

Brass Contributor

Jul 12, 2021

Solved

Need VBA to auto-sum two fields

I'm fairly confident in my ability to edit VBA, but starting from scratch is a little more challenging. I have a file with production numbers, sorted by product code. The nature of my business is t...

Jul 12, 2021

Assuming that the data are in columns A to D and have headers in row 1:

Sub Combine()
    Dim r As Long
    Dim m As Long
    Application.ScreenUpdating = False
    m = Range("A" & Rows.Count).End(xlUp).Row
    Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Header:=xlYes
    For r = m - 1 To 2 Step -1
        If Range("A" & r + 1).Value = Range("A" & r).Value Then
            Range("C" & r).Value = Range("C" & r).Value + Range("C" & r + 1).Value
            Range("D" & r).Value = Range("D" & r).Value + Range("D" & r + 1).Value
            Range("A" & r + 1).EntireRow.Delete
        End If
    Next r
    Application.ScreenUpdating = True
End Sub

If you don't have headers in row 1, use

    For r = m - 1 To 1 Step -1

RandomPanda

Brass Contributor

Jul 12, 2021

German_Chris Thanks for the reply.

I need to keep the formatting of the original in order to copy/paste into our P&L spreadsheet. So, a pivot table wouldn't necessarily be the best solution (I have other fields than just the 3 mentioned that need to transfer over as well). A pivot table, even though a macro to create it would make it faster, is probably not worth the hassle. I don't think I've ever used a Power Query, so I'm not sure if that would work or not.

It's a fairly simple text file that I download from our SOR and then manipulate (as explained) after some research. Then I copy the info to a shared workbook where it does a bunch of other calculations.

HansVogelaar

MVP

Jul 12, 2021

RandomPanda

Assuming that the data are in columns A to D and have headers in row 1:

Sub Combine()
    Dim r As Long
    Dim m As Long
    Application.ScreenUpdating = False
    m = Range("A" & Rows.Count).End(xlUp).Row
    Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Header:=xlYes
    For r = m - 1 To 2 Step -1
        If Range("A" & r + 1).Value = Range("A" & r).Value Then
            Range("C" & r).Value = Range("C" & r).Value + Range("C" & r + 1).Value
            Range("D" & r).Value = Range("D" & r).Value + Range("D" & r + 1).Value
            Range("A" & r + 1).EntireRow.Delete
        End If
    Next r
    Application.ScreenUpdating = True
End Sub

If you don't have headers in row 1, use

    For r = m - 1 To 1 Step -1

RandomPanda
Brass Contributor
Jul 12, 2021
Thank you so much, Hans. Even though this only takes a couple minutes off my daily routine. It will certainly help when I have a lot of these codes.