When found add it to the last and display total in Msgbox

  • Thread starter Thread starter L. Howard
  • Start date Start date
L

L. Howard

I am looking in column A of the sheets for a name and each name will have a value next to it in B. The name may appear multiple times per sheet,
so find next or all is necessary for a total across all sheets.

Assume In code below all is Dimmed correctly, how to add all the varOut's as they are found in column A .Offset(, 1) of each sheet in array.

Can the same code lines be used for constants and values from formulas or is a PasteSpecial.Values needed?

Once I have the correct code lines to add the varOut's I assume I can also use that code with FIND as the search method also?

Not stuck on this code if it can be quicker or more efficient.

Thanks.
Howard


MyArr = Array("Sheet2", "Sheet3", "Sheet4")

For i = LBound(MyArr) To UBound(MyArr)

With Sheets(MyArr(i))
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rngA = .Range("A1:A" & lr)

For Each c In rngA
If c = myName Then
varOut = c.Offset(, 1)

'/ add all the varOut's
'/ together as they are found
'/ across all the sheets
'/ and display total in msgbox

End If
Next 'c

End With
Next 'i

MsgBox "The total for " & myName & " is: " & varOut
 
Hi Howard,

Am Fri, 12 Sep 2014 22:39:26 -0700 (PDT) schrieb L. Howard:
I am looking in column A of the sheets for a name and each name will have a value next to it in B. The name may appear multiple times per sheet,
so find next or all is necessary for a total across all sheets.
Click to expand...

try:
Sub Test()
Dim myArr As Variant
Dim i As Long, lr As Long
Dim rngA As Range, c As Range
Dim myName As String, Firstaddress As String
Dim valOut As Double

myArr = Array("Sheet2", "Sheet3", "Sheet4")
myName = "Name1"

For i = LBound(myArr) To UBound(myArr)
With Sheets(myArr(i))
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rngA = .Range("A1:A" & lr)
Set c = rngA.Find(myName, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
Firstaddress = c.Address
Do
valOut = valOut + c.Offset(, 1)
Set c = rngA.FindNext(c)
Loop While Not c Is Nothing And c.Address <> Firstaddress
End If
End With
Next 'i

MsgBox "The total for " & myName & " is: " & valOut
End Sub

Your sheets have indices. So you can call them by index and sumif 3D
with formula:

=SUM((T(INDIRECT("Sheet"&COLUMN(B:D)&"!A"&ROW(1:1000)))="Name1")*(N(INDIRECT("Sheet"&COLUMN(B:D)&"!B"&ROW(1:1000)))))

and enter the array formula with CTRL+Shift+Enter


Regards
Claus B.
 
Hi Howard,

Am Fri, 12 Sep 2014 22:39:26 -0700 (PDT) schrieb L. Howard:
Assume In code below all is Dimmed correctly, how to add all the varOut's as they are found in column A .Offset(, 1) of each sheet in array.
Click to expand...

the following code writes the matches in Sheet1 column A & B
In column A the sheet name and the cell address, in column B the value

Sub Test2()
Dim myArr As Variant
Dim i As Long, lr As Long, n As Long
Dim rngA As Range, c As Range
Dim myName As String, Firstaddress As String
Dim arrOut() As Variant

myArr = Array("Sheet2", "Sheet3", "Sheet4")
myName = "Name1"

For i = LBound(myArr) To UBound(myArr)
With Sheets(myArr(i))
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rngA = .Range("A1:A" & lr)
Set c = rngA.Find(myName, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
Firstaddress = c.Address
Do
ReDim Preserve arrOut(1, n)
arrOut(0, n) = .Name & "!" & c.Offset(, 1).Address(0, 0)
arrOut(1, n) = c.Offset(, 1)
n = n + 1
Set c = rngA.FindNext(c)
Loop While Not c Is Nothing And c.Address <> Firstaddress
End If
End With
Next 'i

Sheets("Sheet1").Range("A1").Resize(n, 2) = _
Application.Transpose(arrOut)

'MsgBox "The total for " & myName & " is: " & valOut
End Sub


Regards
Claus B.
 
Hi again,

Am Fri, 12 Sep 2014 22:39:26 -0700 (PDT) schrieb L. Howard:
Assume In code below all is Dimmed correctly, how to add all the varOut's as they are found in column A .Offset(, 1) of each sheet in array.
Click to expand...

or do you want to loop through all names and all sheets and then output
the names with the values as array? Then try following code. It writes
the names and the values in Sheet1 columns A&B:

Sub Test3()
Dim myArr As Variant, arrNm As Variant
Dim i As Long, j As Long, lr As Long, n As Long
Dim rngA As Range, c As Range
Dim Firstaddress As String
Dim arrOut(4, 1) As Variant
Dim valOut As Double

myArr = Array("Sheet2", "Sheet3", "Sheet4")
arrNm = Array("Name1", "Name2", "Name3", "Name4", "Name5")

For j = LBound(arrNm) To UBound(arrNm)
For i = LBound(myArr) To UBound(myArr)
With Sheets(myArr(i))
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rngA = .Range("A1:A" & lr)
Set c = rngA.Find(arrNm(j), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
Firstaddress = c.Address
Do
valOut = valOut + c.Offset(, 1)
Set c = rngA.FindNext(c)
Loop While Not c Is Nothing And c.Address <> Firstaddress
End If
End With
Next i
arrOut(n, 0) = arrNm(j)
arrOut(n, 1) = valOut
n = n + 1
Next j

Sheets("Sheet1").Range("A1").Resize(UBound(arrNm) + 1, 2) = arrOut

End Sub


Regards
Claus B.
 
Lots of options, thanks.

I'm pretty sure there is what I want in what you posted.

Will be away from my computer for a while and will look these over as soon as I can.

Thanks a bunch, Claus.

Regards,
Howard
 
Hi again,



Am Fri, 12 Sep 2014 22:39:26 -0700 (PDT) schrieb L. Howard:






or do you want to loop through all names and all sheets and then output

the names with the values as array? Then try following code. It writes

the names and the values in Sheet1 columns A&B:



Sub Test3()

Dim myArr As Variant, arrNm As Variant

Dim i As Long, j As Long, lr As Long, n As Long

Dim rngA As Range, c As Range

Dim Firstaddress As String

Dim arrOut(4, 1) As Variant

Dim valOut As Double



myArr = Array("Sheet2", "Sheet3", "Sheet4")

arrNm = Array("Name1", "Name2", "Name3", "Name4", "Name5")



For j = LBound(arrNm) To UBound(arrNm)

For i = LBound(myArr) To UBound(myArr)

With Sheets(myArr(i))

lr = .Cells(.Rows.Count, 1).End(xlUp).Row

Set rngA = .Range("A1:A" & lr)

Set c = rngA.Find(arrNm(j), LookIn:=xlValues, lookat:=xlWhole)

If Not c Is Nothing Then

Firstaddress = c.Address

Do

valOut = valOut + c.Offset(, 1)

Set c = rngA.FindNext(c)

Loop While Not c Is Nothing And c.Address <> Firstaddress

End If

End With

Next i

arrOut(n, 0) = arrNm(j)

arrOut(n, 1) = valOut

n = n + 1

Next j



Sheets("Sheet1").Range("A1").Resize(UBound(arrNm) + 1, 2) = arrOut



End Sub





Regards

Claus B.
Click to expand...

The code Sub Test3() works well for what I am looking for.

This works for the arrNM hardcoded.
arrNm = Array("Name1", "Name2", "Name3")


Trying to read F1:Fn into arrNm where F1 to F3 are Name1, Name2, Name3. (Or more)
This errors out
arrNm = Sheets("Sheet1").Range("F1:F" & LRow)

Howard
 
The code Sub Test3() works well for what I am looking for.
This works for the arrNM hardcoded.
arrNm = Array("Name1", "Name2", "Name3")


Trying to read F1:Fn into arrNm where F1 to F3 are Name1, Name2,
Name3. (Or more)
This errors out
arrNm = Sheets("Sheet1").Range("F1:F" & LRow)
Click to expand...

What's the error?
How is arrNm declared?

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
What's the error?

How is arrNm declared?
Click to expand...


Hi Garry,

Error message is:

Application-defined or object-defined

with entire line yellowed out


This is how I have it in a standard module

Sub Test3()
Dim myArr As Variant

'/ Need to read F1:F? into arrNm
Dim arrNm() As Variant

Dim i As Long, j As Long, LR As Long, n As Long
Dim rngA As Range, c As Range
Dim Firstaddress As String
Dim arrOut(4, 1) As Variant
Dim valOut As Double
Dim LRow As Long
myArr = Array("Sheet2", "Sheet3", "Sheet4")

arrNm = Sheets("Sheet1").Range("F1:F" & LRow)
'arrNm = Array("Name1", "Name2", "Name3")

For j = LBound(arrNm) To UBound(arrNm)

For i = LBound(myArr) To UBound(myArr)
With Sheets(myArr(i))

LR = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rngA = .Range("A1:A" & LR)

Set c = rngA.Find(arrNm(j), LookIn:=xlValues, lookat:=xlWhole)

If Not c Is Nothing Then
Firstaddress = c.Address
Do

valOut = valOut + c.Offset(, 1)

Set c = rngA.FindNext(c)
Loop While Not c Is Nothing And c.Address <> Firstaddress
End If
End With
Next i

arrOut(n, 0) = arrNm(j)
arrOut(n, 1) = valOut

n = n + 1

Next j

'/Put Lookup string in A1 and sum of offset values in B1
Sheets("Sheet1").Range("A1").Resize(UBound(arrNm) + 1, 2) = arrOut

'/ Sum of lookup values in A1
'Sheets("Sheet1").Range("A1") = valOut
End Sub


Howard
 
Ok.., according to your code this..
arrNm = Sheets("Sheet1").Range("F1:F" & LRow)
Click to expand...

is the same as this...
arrNm = Sheets("Sheet1").Range("F1:F0")

Also, this won't work...
arrOut(n, 0) = arrNm(j)

...because arrNm is a 1-based 2D array.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Ok.., according to your code this..




is the same as this...

arrNm = Sheets("Sheet1").Range("F1:F0")



Also, this won't work...

arrOut(n, 0) = arrNm(j)



..because arrNm is a 1-based 2D array.
Click to expand...

I see my error here, this seems to fix that.
arrNm = Sheets("Sheet1").Range("F1:F" & Cells(Rows.Count, "F").End(xlUp).Row)

I have no idea what to do here.
arrOut(n, 0) = arrNm(j)

Howard
 
Hi Howard,

Am Sun, 14 Sep 2014 22:53:22 -0700 (PDT) schrieb L. Howard:
I have no idea what to do here.
arrOut(n, 0) = arrNm(j)
Click to expand...

try:

Sub Test3()
Dim myArr As Variant, arrNm As Variant
Dim i As Long, j As Long, lr As Long, n As Long, LRow As Long
Dim rngA As Range, c As Range
Dim myName As String, Firstaddress As String, myStr As String
Dim arrOut() As Variant
Dim valOut As Double

myArr = Array("Sheet2", "Sheet3", "Sheet4")
LRow = Sheets("Sheet1").Cells(Rows.Count, "F").End(xlUp).Row
arrNm = Sheets("Sheet1").Range("F1:F" & LRow)

For j = LBound(arrNm) To UBound(arrNm)
For i = LBound(myArr) To UBound(myArr)
With Sheets(myArr(i))
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rngA = .Range("A1:A" & lr)
Set c = rngA.Find(arrNm(j, 1), LookIn:=xlValues,
lookat:=xlWhole)
If Not c Is Nothing Then
Firstaddress = c.Address
Do
valOut = valOut + c.Offset(, 1)
Set c = rngA.FindNext(c)
Loop While Not c Is Nothing And c.Address <> Firstaddress
End If
End With
Next i
ReDim Preserve arrOut(LRow, 1)
arrOut(n, 0) = arrNm(j, 1)
arrOut(n, 1) = valOut
n = n + 1
Next j

Sheets("Sheet1").Range("A1").Resize(UBound(arrNm) + 1, 2) = arrOut

End Sub


Regards
Claus B.
 
try:



Sub Test3()

Dim myArr As Variant, arrNm As Variant

Dim i As Long, j As Long, lr As Long, n As Long, LRow As Long

Dim rngA As Range, c As Range

Dim myName As String, Firstaddress As String, myStr As String

Dim arrOut() As Variant

Dim valOut As Double



myArr = Array("Sheet2", "Sheet3", "Sheet4")

LRow = Sheets("Sheet1").Cells(Rows.Count, "F").End(xlUp).Row

arrNm = Sheets("Sheet1").Range("F1:F" & LRow)



For j = LBound(arrNm) To UBound(arrNm)

For i = LBound(myArr) To UBound(myArr)

With Sheets(myArr(i))

lr = .Cells(.Rows.Count, 1).End(xlUp).Row

Set rngA = .Range("A1:A" & lr)

Set c = rngA.Find(arrNm(j, 1), LookIn:=xlValues,

lookat:=xlWhole)

If Not c Is Nothing Then

Firstaddress = c.Address

Do

valOut = valOut + c.Offset(, 1)

Set c = rngA.FindNext(c)

Loop While Not c Is Nothing And c.Address <> Firstaddress

End If

End With

Next i

ReDim Preserve arrOut(LRow, 1)

arrOut(n, 0) = arrNm(j, 1)

arrOut(n, 1) = valOut

n = n + 1

Next j



Sheets("Sheet1").Range("A1").Resize(UBound(arrNm) + 1, 2) = arrOut



End Sub
Click to expand...
Regards

Claus B.

--
Click to expand...

Thanks Claus, of course it works great.
I may never get my head around arrays, funny though, I can read down the code and tell you what about 98% of it is doing but it is not yet logical to me to write it out on my own.

I guess I was the same way with VLOOKUP to start with and now I seldom even test VLOOKUP's before offering a formula to someone.

Sure are a lot of T's to cross and a lot of i's to dot before an array will work.

And the example Garry offered is quite familiar in the google examples I study prior to posting here. Must be a dozen ways to do the same task it seems to me.

Thank you Garry and Claus.
 
Hi Howard,

Am Mon, 15 Sep 2014 00:03:00 -0700 (PDT) schrieb L. Howard:
I may never get my head around arrays, funny though, I can read down the code and tell you what about 98% of it is doing but it is not yet logical to me to write it out on my own.
Click to expand...

arrNm = Array("Name1", "Name2", "Name3", "Name4", "Name5")

In this case arrNm is a 0-based 1D array
Name1 = arrNm(0)
Name2=arrNm(1)

arrNm = Sheets("Sheet1").Range("F1:F" & LRow)
An array out of a range is a 1-based 2D-array

Name1 =arrNm(1,1)
Name2 = arrNm(2,1)


Regards
Claus B.
 
Sure are a lot of T's to cross and a lot of i's to dot before an
array will work.
Click to expand...

Actually, one day the light will come on and you'll be tickled that it
all just 'clicked'!<g>

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Hi Howard,



Am Mon, 15 Sep 2014 00:03:00 -0700 (PDT) schrieb L. Howard:






arrNm = Array("Name1", "Name2", "Name3", "Name4", "Name5")



In this case arrNm is a 0-based 1D array

Name1 = arrNm(0)

Name2=arrNm(1)



arrNm = Sheets("Sheet1").Range("F1:F" & LRow)

An array out of a range is a 1-based 2D-array



Name1 =arrNm(1,1)

Name2 = arrNm(2,1)





Regards

Claus B.
Click to expand...


Garry was pointing this out to me and the example does so also.

Am aware zero based and 1 based exist, but easily prone to miss use them.

Thanks.
 
Hi again,

Am Mon, 15 Sep 2014 00:49:25 -0700 (PDT) schrieb L. Howard:
Am aware zero based and 1 based exist, but easily prone to miss use them.
Click to expand...

did you try the array formula from my first answer?


Regards
Claus B.
 
Back
Top