Total columns Based on another cells value

[George]

Good Day,

I trying to use VBA to calculate totals in multiple columns when it see
uniques values in another Column..in the example below column "A" contains
user names while columns "B, C, D" contain the values I want totaled based
on the user name in column "A"...An additional thing would be have it place
the values with the user name on a new worksheet.

Col A Col B Col C Col D
John Smith 1.0 1.0 1.0
John Smith 1.25 1.25 2.0
Mary Johnson .75 1.0 2.5
Jack Johnson 1.0 1.0 1.0

The new worksheet would look as follows

Col A Col B Col C Col D
John Smith 2.25 2.25 3.0
Mary Johnson .75 1.0 2.5
Jack Johnson 1.0 1.0 1.0

Thank you in advance for your help
George

 

[Dave Peterson]

You could use Data|Subtotals (xl2003 menus) and keep the data and the subtotals
on the same sheet.

You'll be able to hide the details by using the outlining symbols at the left.

You could even hide the details, select the range to copy (just the visible
cells) and paste special to the new worksheet -- but why bother????

Another option is to learn about pivottables. They would do what you ask (as a
separate sheet).

If you've never used pivottables, here are a few links:

Debra Dalgleish's pictures at Jon Peltier's site:
http://peltiertech.com/Excel/Pivots/pivottables.htm
And Debra's own site:
http://www.contextures.com/xlPivot01.html

John Walkenbach also has some at:
http://j-walk.com/ss/excel/files/general.htm
(look for Tony Gwynn's Hit Database)

Chip Pearson keeps Harald Staff's notes at:
http://www.cpearson.com/excel/pivots.htm

MS has some at (xl2000 and xl2002):
http://office.microsoft.com/downloads/2000/XCrtPiv.aspx
http://office.microsoft.com/assistance/2002/articles/xlconPT101.aspx

 

[George]

Hi Dave thanks for your reply..

I have found some code that does what trying to do, but now I've been told
the values need to be averaged not summed. Could you look at this a give me
some clue as to how I might get the average..

Sub CreateAverage()
Dim iLastRow As Long
Dim i As Long
Dim iRow As Long

iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 2 Step -1
iRow = Application.Match(Cells(i, "A").Value, Columns(4), 0)
If iRow < i Then
Cells(iRow, "B").Value = Cells(iRow, "B").Value + Cells(i,
"B").Value
Cells(iRow, "C").Value = Cells(iRow, "C").Value + Cells(i,
"C").Value
Cells(iRow, "D").Value = Cells(iRow, "D").Value + Cells(i,
"D").Value
Rows(i).Delete
End If
Next i

End Sub

Thank You
George

 

[Dave Peterson]

I'd still use data|subtotals or a pivottable. They both support averages.

 

[Dave Peterson]

But if you want...

If I were doing this manually, I'd use 3 additional columns (E:G) and plop a
formula in there that would do the work.

With headers in row 1 (add them if you don't have them already), I'd put this in
E2:

=IF(COUNTIF($A$1:$A2,$A2)>1,NA(),SUMIF($A:$A,$A2,B:B)/COUNTIF($A:$A,$A2))

This will put an error (#N/A) in the cells where the name isn't the first
occurrence in column A.

And then it just does a simple =sumif()/countif() to get the average.

Then I'd drag the formulas down the range and to the right (another two
columns).

Then I'd convert to values.
Delete the old data (columns B) and shifting E:G over to B.
Then delete the rows with errors.
Select columns B
ctrl-g (edit|Goto in xl2003 menus)
Special|constant (but just errors)
then
Edit|Delete|Entire row

In code...

Option Explicit
Sub testme()

Dim wks As Worksheet
Dim myRng As Range

Set wks = Worksheets("Sheet1")

With wks
'copy the headers from B to E:G
.Range("B11").Copy _
Destination:=.Range("E1")

'plop the formula into those 3 new columns to the right
With .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)) _
.Offset(0, 4).Resize(, 3)

.Formula _
= "=IF(COUNTIF($A$1:$A2,$A2)>1,NA()," _
& "SUMIF($A:$A,$A2,B:B)/COUNTIF($A:$A,$A2))"

'convert to values
.Value = .Value
End With

'Delete columns B
.Range("B").Delete

'delete the rows with errors in the new columns B
On Error Resume Next
.Range("B").Cells.SpecialCells(xlCellTypeConstants, xlErrors) _
.EntireRow.Delete
On Error GoTo 0

End With

End Sub

The on error stuff is required if there are no errors (singleton entries only).