new to macros

[sms2322]

hoping someone here can help, im decent with excell but just heard about macros... here is what i want to do and i feel like there should be an easy way to do it...any ideas would be appreciated:

initial sheet...
A B C D
L2 amy 2 1
P4 bill 4 4
D4 jill 1 2
L2 amy 3 3
N5 john 7 8
D4 jill 8 3

desired results...
A B C D
L2 amy 5 4
P4 bill 4 4
N5 john 7 8
D4 jill 9 5

 

[Cindy Ellis]

Hi, and welcome to the forum!
You can do this without a macro if you want to...
If you put a header on each column, you can use a pivot table to create the output you want. Assuming Excel 2007 (it's a bit different in previous versions, and I haven't used a later version yet),
1. Highlight the data including the header row, click the "Insert" tab, and select Pivot table.
2. In the pivot table Field List, drag the first 2 fields to the "Row Labels" quadrant of the pivot table panel.
3. Drag the 3rd and 4th fields to the "Values" quadrant. It should default to "Sum of..." followed by the field name for each of these 2 fields.
4. Select the PivotTable Tools tab at the very top of the window, then select "Design".
4. In the Layout group, select Subtotals, and select "Do not show Subtotals". Select Grand Totals, and select "Off for rows and columns".
5. Select Report Layout, then "Show in Tabular Form".

That should produce the output you want.
Good luck,

Cindy

 

[mirabeau]

If you really want a macro

Sub reorganize()
Dim a As Range, n As Long
Dim i As Long, j As Long
Set a = Range("A1").CurrentRegion
n = a.Rows.Count
For i = 2 To n
    If a(i, 2) <> "" Then
    For j = i + 1 To n
        If a(i, 2) = a(j, 2) Then
            a(i, 3) = a(i, 3) + a(j, 3)
            a(i, 4) = a(i, 4) + a(j, 4)
            a(j, 2).Resize(, 3).ClearContents
        End If
    Next j
    End If
Next i
a.Columns(2).SpecialCells(4).EntireRow.Delete
End Sub

 

[Glory]

Or if you want a slower, crappier macro:

Sub CompileUniqueEntries()
 
Dim Cell1   As Range
Dim a1      As Worksheet
Dim a2, a3  As Long
Dim b1, b2  As Long
Dim c1      As Long
Dim c2()    As Variant
Dim d1      As Boolean
 
Set a1 = ThisWorkbook.ActiveSheet
a2 = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
 
For Each Cell1 In a1.Range("A1:A" & a2)
 
    For Each Cell2 In a1.Range("A1:A" & a2)
 
        If Cell2 = Cell1 Then
 
            b1 = b1 + Cell2.Offset(0, 2)
            b2 = b2 + Cell2.Offset(0, 3)
 
        End If
 
    Next
 
    If a3 = 0 Then
 
        a3 = 1
 
    Else
 
        a3 = (a1.Range("E" & Rows.Count).End(xlUp).Row) + 1
 
    End If
 
        c1 = c1 + 1
 
    ReDim Preserve c2(1 To c1)
 
        For Each element In c2()
 
            If Cell1 = element Then d1 = True
 
        Next
 
    If Not d1 Then
 
        c2(c1) = Cell1
 
        a1.Range("E" & a3) = c2(c1)
        a1.Range("F" & a3) = Cell1.Offset(0, 1)
        a1.Range("G" & a3) = b1
        a1.Range("H" & a3) = b2
 
    End If
 
    d1 = False
 
Next
 
a1.Range("A1:D" & a2).ClearContents
a1.Range("E1:H" & a3).Cut a1.Range("A1")
 
End Sub