Add 2 rows via VBA Help Needed

[gizmo0202]

I need to take the data from one spreadsheet that looks like this:

karen 1 3 2 1
craig 2 1 1 1
karen 1 2 1 1

and create a new set of rows that look like this:

karen 2 5 3 2
craig 2 1 1 1

There is no real order to the names - just that they may appear 2 or 3 times in the list.

Thanks for your help!!!

 

[hiker95]

gizmo0202,


Sample raw data in worksheet Sheet1:

Excel Workbook
	A	B	C	D	E	F
1	karen	1	3	2	1
2	craig	2	1	1	1
3	karen	1	2	1	1
4
Sheet1

After the macro in a new worksheet Results:

Excel Workbook
	A	B	C	D	E	F
1	karen	2	5	3	2
2	craig	2	1	1	1
3
Results

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub SumData()
' hiker95, 04/05/2011
' http://www.mrexcel.com/forum/showthread.php?t=541214
Dim w1 As Worksheet, wR As Worksheet
Dim LR As Long, LC As Long, LR2 As Long
Application.ScreenUpdating = False
Set w1 = Worksheets("Sheet1")
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wR = Worksheets("Results")
wR.UsedRange.Clear
Set wR = Worksheets("Results")
LR = w1.Cells(Rows.Count, 1).End(xlUp).Row
LC = w1.Cells.Find("*", , xlValues, xlWhole, xlByColumns, xlPrevious, False).Column
w1.Rows(1).Insert
w1.Range("A1") = "A"
w1.Columns(1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wR.Columns(1), Unique:=True
w1.Rows(1).Delete
wR.Rows(1).Delete
LR2 = wR.Cells(Rows.Count, 1).End(xlUp).Row
wR.Range(wR.Cells(1, 2), wR.Cells(LR2, LC)).Formula = "=SUMIF(Sheet1!$A:$A,$A1,Sheet1!B:B)"
Application.ScreenUpdating = True
End Sub

Then run the SumData macro.