Thank you for your help. This works great. Colin.
--
Thank you,

Colin.


"JLatham" wrote:

Early in the code there is a line that reads:
Dim Expenditures() As Single

You might try changing that to
Dim Expenditures() As Variant

I presumed your entries for expenditures were probably all numeric and
possibly currency, but wasn't certain. If this doesn't work, post back.
Check that all entries in the expenditures column are at least numeric,
either General or Currency?

Second attempt to send---

"Colin" wrote:

Thank you very much for your help.
I have created the thirteen sheets and named them accordingly.
I have created the same headings on Row 1 of each sheet (including sheet 13)
and have in column B 'Client' and in Column F 'Margin' and have altered the
appropiate code accordingly.
When running the macro it Debugs to the code:

Expenditures(LC) = Expenditures(LC) + _
anyName.Offset(0, offset2Expenditures)

and records a run time error '13'. Type mismatch.
What do I have to alter to ensure the macro runs smoothly?

Thanks, Colin.



"JLatham" wrote:

well, hopefully this will get the work down to a minimum. This code will
gather a list of all unique names on the 12 sheets, total up the expenditures
for each one, and put the results on an "annual summary" sheet. At that
point you can begin massaging the data, creating charts, etc. Note that it
does erase all existing data on that annual summary sheet before presenting
what it found during its processing.

To put the code into your workbook: open the workbook, press [Alt]+[F11] to
open the VB Editor. In the VBE, choose Insert -- Module. Copy and paste
the code into that module. Edit the code as needed to change the 4 Const
values to match the setup in your workbook/worksheets. Close the VBE. Give
it a trial run.

Sub CreateAnnualSummary()
'this process assumes:
' #1 - there are 13 sheets in the workbook:
' the 12 monthly sheets plus one more
' named [AnnualSummary]
' #2 - That all sheets are laid out the same
' way; that names are in same column in
' all sheets, and that expenditures are
' in same column on all sheets.
' #3 - That the first data entry is on the
' same row on all sheets.
'
' run from Tools -- Macro -- Macros
'
'you can change these Const values to
'match the layout of your workbook/worksheets
Const summarySheetName = "AnnualSummary"
Const namesColumn = "A"
Const expendituresColumn = "B"
Const firstDataRow = 2 ' assumes row 1 = labels.

Dim anyWS As Worksheet
Dim namesFound() As String
Dim Expenditures() As Single
Dim offset2Expenditures As Integer
Dim namesListRange As Range
Dim anyName As Range
Dim LC As Integer
Dim existsFlag As Boolean

'start by compiling a list of unique
'names from the monthly sheets
ReDim namesFound(1 To 1)
For Each anyWS In ThisWorkbook.Worksheets
If anyWS.Name < summarySheetName Then
Set namesListRange = anyWS.Range(namesColumn & firstDataRow & _
":" & anyWS.Range(namesColumn & Rows.Count).End(xlUp).Address)
For Each anyName In namesListRange
If Not IsEmpty(anyName) Then
existsFlag = False
For LC = LBound(namesFound) To UBound(namesFound)
If UCase(Trim(anyName)) = UCase(namesFound(LC)) Then
existsFlag = True
Exit For
End If
Next
If Not existsFlag Then
'add name to the list
namesFound(UBound(namesFound)) = Trim(anyName)
ReDim Preserve namesFound(1 To UBound(namesFound) + 1)
End If
End If
Next
End If
Next
If UBound(namesFound) 1 Then
'remove empty element at the end of the array
ReDim Preserve namesFound(1 To UBound(namesFound) - 1)
Else
MsgBox "No names found!"
Set namesListRange = Nothing
Exit Sub
End If
'now for the tedious part
'go back through all 12 months
'take each name we found before, try to
'find entries for it on each sheet
'and total up the expenses for that name
'
offset2Expenditures = Range(expendituresColumn & 1).Column - _
Range(namesColumn & 1).Column
ReDim Expenditures(1 To UBound(namesFound))
For Each anyWS In ThisWorkbook.Worksheets
If anyWS.Name < summarySheetName Then
Set namesListRange = anyWS.Range(namesColumn & firstDataRow & _
":" & anyWS.Range(namesColumn & Rows.Count).End(xlUp).Address)
For Each anyName In namesListRange
If Not IsEmpty(anyName) Then
For LC = LBound(namesFound) To UBound(namesFound)
If UCase(Trim(anyName)) = UCase(namesFound(LC)) Then
'add the expendetures
Expenditures(LC) = Expenditures(LC) + _
anyName.Offset(0, offset2Expenditures)
Exit For
End If
Next
End If
Next
End If
Next
Set namesListRange = Nothing
'
'final step, put the results onto the AnnualSummary sheet
'
Set anyWS = ThisWorkbook.Worksheets(summarySheetName)
anyWS.Cells.ClearContents
For LC = LBound(namesFound) To UBound(namesFound)
anyWS.Range(namesColumn & Rows.Count).End(xlUp).Offset(1, 0) = _
namesFound(LC)
anyWS.Range(namesColumn & Rows.Count).End(xlUp).Offset(0, 1) = _
Expenditures(LC)
Next
Set anyWS = Nothing
End Sub



"Colin" wrote:

I have twelve worksheets (one for each month of the year). On them are
customers and expenditure figures. Each sheet has some customers repeated and
also some different ones. I want a thirteenth sheet that lists all the
different customers from the year and shows their total expenditure for the
year. I can then add some graphs and sort the accumulative data into 'top
ten' and 'worst ten' customers etc.

How do I create this thirteenth sheet with minimum manual labour?
--
Thank you,

Colin.