Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
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


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Quick help needed... BAW Excel Worksheet Functions 2 October 27th 06 06:33 PM
Quick Simple VB Snippet Needed Tim H[_2_] Excel Programming 2 March 7th 06 06:39 PM
Quick and easy solution needed! grahamhurlburt[_3_] Excel Programming 1 December 24th 05 04:43 AM
quick code needed saziz[_33_] Excel Programming 6 December 15th 05 10:38 PM
macro to delete entire rows when column A is blank ...a quick macro vikram Excel Programming 4 May 3rd 04 08:45 PM


All times are GMT +1. The time now is 12:01 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"