View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
keiji kounoike keiji kounoike is offline
external usenet poster
 
Posts: 199
Default Quick Macro Needed

This is another approach.

Sub sumsheets()
'Change const below according to your layout
Const curname = "A" 'Column's name of name in output worksheet
Const curnum = "B" 'Column's name of sum in output worksheet
Const colname = "C" 'column's name of name in data worksheets
Const colnum = "B" 'column's name of number in data worksheets

Dim acsh As Worksheet, sh As Worksheet
Dim rng1 As Range, rng2 As Range
Dim i As Long, n As Long
Dim strformula As String
Dim arlist, tmp

Set acsh = ActiveSheet
arlist = Range(Cells(1, curname), Cells(1, curname).End(xlDown)).Value
For i = 1 To UBound(arlist, 1)
For Each sh In Worksheets
If sh.Name < ActiveSheet.Name Then
With sh
n = .Cells(1, colname).End(xlDown).Row
Set rng1 = .Range(.Cells(1, colname), .Cells(n, colname))
Set rng2 = .Range(.Cells(1, colnum), .Cells(n, colnum))
strformula = strformula & "+sumproduct(--(" & rng1.Parent.Name _
& "!" & rng1.Address & "=""" & arlist(i, 1) & """)," _
& rng2.Parent.Name & "!" & rng2.Address & ")"
End With
End If
Next
tmp = acsh.Cells(i, curnum).Value
acsh.Cells(i, curnum).Formula = "=" & strformula
If VarType(tmp) = vbString Then
acsh.Cells(i, curnum).Value = tmp
End If
strformula = ""
Next
End Sub

Keji

DaveH wrote:
Don,
Thanks for the quick reply.
I could not get the macro to work correctly but I did have to move the info
in the sheets around for formatting.
The names are in column C of each sheet and the data is in column B. There
is other information in those columns that may be interfering with the macro.
I have a sheet with the names Im looking for in column A if that would help.


"Don Guillett" wrote:

Use this macro assigned to a button or shape

Option Explicit
Sub sumeachsheet()
Dim n As Range
Dim ms As Long
Dim ws As Worksheet
Dim c, firstaddress

For Each n In Range _
("a2:a" & Cells(Rows.Count, 1).End(xlUp).Row)
ms = 0
For Each ws In Worksheets
If ws.Name < ActiveSheet.Name Then
With ws.Columns(1)
Set c = .Find(n, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not c Is Nothing Then
firstaddress = c.Address
Do
ms = ms + c.Offset(, 1)
Set c = .FindNext(c)
Loop While Not c Is Nothing And _
c.Address < firstaddress
End If
End With
End If
Next ws
n.Offset(, 1) = ms
Next n
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"DaveH" wrote in message
...
I need to go thru several worksheets and look for a specific set of text in
row A, and add up the values next to the text in row B and save that into
a
group of cells in the current sheet.

I.e. Search criteria Dog, Cat, Bird, Snake.

Worksheet 1
Dog 12
Cat 1
Bird 3

Worksheet 2
Cat 1
Snake 2

Worksheet 3
Dog 1
Snake 10


Output to cells in current worksheet
Dog 13
Cat 2
Bird 3
Snake 12
Any help would be greatly appreciated.
Dave