SOLVED

Need VBA to auto-sum two fields

Brass Contributor

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 that some partial pallets get held to the next day in order to fill them to the top with product. So, for daily yields, I need to take out the previous day's production from today's numbers. So, my file contains code "1234" with "-1" pallet and "-500" lbs. and a second line (today's totals) with code "1234", "15" pallets and "15000" lbs. I want the macro to search for duplicate product codes, combine the two pallet and lb. numbers and then delete the line with the negative amounts. 

 

So the result of the below lines would be a single line showing 14 pallets and 14500 lbs.

A               B                    C                D

1234      description        -1             -500

1234      description        15             15000

 

of course, this would need to loop until no more duplicates are found. And, to add a snag, or error-handling, if there are no duplicates, but still have negatives in either pallet or weight field, it should ignore those (and I'll deal with them manually).

 

Thanks in advance for any help you can offer. 

 

6 Replies
Why do you not use a Pivottable or normal Grouping or PowerQuery to Group and get a new Table.

@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.

best response confirmed by RandomPanda (Brass Contributor)
Solution

@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
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.

@German_Chris You are sooooo right. Quite amazing to see that people still choose to revert to complicated VBA solutions to do very simple things, rather than using built-in functionalities that require a few button clicks. No coding required. Attaching a workbook that demonstrates just that. 

1 best response

Accepted Solutions
best response confirmed by RandomPanda (Brass Contributor)
Solution

@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

View solution in original post