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

  • Thread starter Thread starter L. Howard
  • Start date Start date
Am Mon, 15 Sep 2014 00:49:25 -0700 (PDT) schrieb L. Howard:
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.
Click to expand...


Regards
Claus B.
 
Hi Howard,

Am Mon, 15 Sep 2014 00:03:00 -0700 (PDT) schrieb L. Howard:
Thanks Claus, of course it works great.
Click to expand...

no, it doesn't.
It is important to reset valOut to 0:

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)
valOut = 0
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.
 
Hi Howard,



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






no, it doesn't.

It is important to reset valOut to 0:



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)

valOut = 0

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.

--
Click to expand...

Okay, I see the revised version will return 0 for Names in column F that do not occur on the sheets and the old version returned false values for those Names.

And since the array is 2D, both codes require at least two Names in col F? I tried one and it errors out on this line:

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

A 'space' or a plain "x" as the second name returns 0. Nature of the beast, I assume.

Howard
 
Hi Howard,

Am Mon, 15 Sep 2014 03:32:37 -0700 (PDT) schrieb L. Howard:
And since the array is 2D, both codes require at least two Names in col F? I tried one and it errors out on this line:
Click to expand...

no, a 2D array has two indices. One for the row and one for the column
corresponding the reference with cells.
A1 = cells(1,1)
And the array works the same way. Step with F8 through your code and if
the array is filled look into the watch window for the items and the
indices.


Regards
Claus B.
 
Back
Top