Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Quick help needed... | Excel Worksheet Functions | |||
Quick Simple VB Snippet Needed | Excel Programming | |||
Quick and easy solution needed! | Excel Programming | |||
quick code needed | Excel Programming | |||
macro to delete entire rows when column A is blank ...a quick macro | Excel Programming |