Loop thru xx No. of sheets until the four strValue combo's are found

H

Howard

I'm trying to modify some archived code to lookup four inputs and return a fifth, which is the price.

This works fine on a single sheet but I may have to take the bushel basket full of strValue's and look for that combination across 4,5 maybe 6 sheets.

The "For Each rngCell In Range("A1:A" & lngLstRow)" of sheet Data1, Data2, Data3etc. has me stumped.

I haven't gotten this far yet, but with that many inputs, I probably want to list the inputs and the price when found. I'll be working on that in the meantime.

Thanks.
Howard

Option Explicit

Sub Lookup_Four_Return_Fifth()

Dim rngCell As Range
Dim lngLstRow As Long
Dim strValue(1 To 4) As String
Dim intVStore(1 To 50) As Integer
Dim intValVar As Integer

lngLstRow = ActiveSheet.UsedRange.Rows.Count
strValue(1) = InputBox("Input DA:", "DA") 'Col A
strValue(2) = InputBox("Input AA:", "AA") 'Col B
strValue(3) = InputBox("Input P:", "P") 'Col C
strValue(4) = InputBox("Input HAULER:", "HAULER") 'Col D
intValVar = 1

For Each rngCell In Range("A1:A" & lngLstRow)
If rngCell.Value = strValue(1) And _
rngCell.Offset(0, 1).Value = strValue(2) And _
rngCell.Offset(0, 2).Value = strValue(3) And _
rngCell.Offset(0, 3).Value = strValue(4) Then
intVStore(intValVar) = rngCell.Offset(0, 4).Value ' COL E
intValVar = intValVar + 1
Else
End If
Next

MsgBox ("The Priced is: " & WorksheetFunction.Max(intVStore()))
End Sub
 
C

Claus Busch

Hi Howard,

Am Thu, 15 Aug 2013 06:08:01 -0700 (PDT) schrieb Howard:
I'm trying to modify some archived code to lookup four inputs and return a fifth, which is the price.

This works fine on a single sheet but I may have to take the bushel basket full of strValue's and look for that combination across 4,5 maybe 6 sheets.

The "For Each rngCell In Range("A1:A" & lngLstRow)" of sheet Data1, Data2, Data3etc. has me stumped.

I haven't gotten this far yet, but with that many inputs, I probably want to list the inputs and the price when found. I'll be working on that in the meantime.
Click to expand...

try it with StringCompare:

Sub Lookup_Four_Return_Fifth2()
Dim lngLstRow As Long
Dim str1 As String
Dim str2 As String
Dim i As Long
Dim intVStore(1 To 50) As Integer
Dim intValVar As Integer
Dim wsh As Worksheet

str1 = InputBox("Input DA:", "DA") & InputBox("Input AA:", "AA") _
& InputBox("Input P:", "P") & InputBox("Input HAULER:", "HAULER")
intValVar = 1

For Each wsh In ThisWorkbook.Worksheets
lngLstRow = wsh.UsedRange.Rows.Count
For i = 1 To lngLstRow
str2 = Cells(i, 1) & Cells(i, 2) & Cells(i, 3) & Cells(i, 4)
If StrComp(str1, str2, 1) = 0 Then
intVStore(intValVar) = Cells(i, 5).Value ' COL E
intValVar = intValVar + 1
End If
Next
Next wsh
MsgBox ("The Price is: " & WorksheetFunction.Max(intVStore()))
End Sub


Regards
Claus B.
 
H

Howard

try it with StringCompare:



Sub Lookup_Four_Return_Fifth2()

Dim lngLstRow As Long

Dim str1 As String

Dim str2 As String

Dim i As Long

Dim intVStore(1 To 50) As Integer

Dim intValVar As Integer

Dim wsh As Worksheet



str1 = InputBox("Input DA:", "DA") & InputBox("Input AA:", "AA") _

& InputBox("Input P:", "P") & InputBox("Input HAULER:", "HAULER")

intValVar = 1



For Each wsh In ThisWorkbook.Worksheets

lngLstRow = wsh.UsedRange.Rows.Count

For i = 1 To lngLstRow

str2 = Cells(i, 1) & Cells(i, 2) & Cells(i, 3) & Cells(i, 4)

If StrComp(str1, str2, 1) = 0 Then

intVStore(intValVar) = Cells(i, 5).Value ' COL E

intValVar = intValVar + 1

End If

Next

Next wsh

MsgBox ("The Price is: " & WorksheetFunction.Max(intVStore()))

End Sub


Regards

Claus B.
Click to expand...

Whoa! I like that!! thanks, Claus.

Regards,
Howard
 
C

Claus Busch

Hi Howard,

Am Thu, 15 Aug 2013 07:07:06 -0700 (PDT) schrieb Howard:
Whoa! I like that!! thanks, Claus.
Click to expand...

there was a little error into the code and the array is now only as
large as needed.
Change it to:

Sub Lookup_Four_Return_Fifth2()
Dim lngLstRow As Long
Dim str1 As String
Dim str2 As String
Dim i As Long
Dim intVStore() As Double
Dim intValVar As Integer
Dim wsh As Worksheet

str1 = InputBox("Input DA:", "DA") & InputBox("Input AA:", "AA") _
& InputBox("Input P:", "P") & InputBox("Input HAULER:", "HAULER")

For Each wsh In ThisWorkbook.Worksheets
With wsh
lngLstRow = .UsedRange.Rows.Count
For i = 1 To lngLstRow
str2 = .Cells(i, 1) & .Cells(i, 2) & _
.Cells(i, 3) & .Cells(i, 4)
If StrComp(str1, str2, 1) = 0 Then
ReDim Preserve intVStore(intValVar)
intVStore(intValVar) = .Cells(i, 5).Value
intValVar = intValVar + 1
End If
Next
End With
Next wsh
MsgBox ("The Price is: " & WorksheetFunction.Max(intVStore()))
End Sub


Regards
Claus B.
 
H

Howard

there was a little error into the code and the array is now only as

large as needed.

Change it to:



Sub Lookup_Four_Return_Fifth2()

Dim lngLstRow As Long

Dim str1 As String

Dim str2 As String

Dim i As Long

Dim intVStore() As Double

Dim intValVar As Integer

Dim wsh As Worksheet



str1 = InputBox("Input DA:", "DA") & InputBox("Input AA:", "AA") _

& InputBox("Input P:", "P") & InputBox("Input HAULER:", "HAULER")



For Each wsh In ThisWorkbook.Worksheets

With wsh

lngLstRow = .UsedRange.Rows.Count

For i = 1 To lngLstRow

str2 = .Cells(i, 1) & .Cells(i, 2) & _

.Cells(i, 3) & .Cells(i, 4)

If StrComp(str1, str2, 1) = 0 Then

ReDim Preserve intVStore(intValVar)

intVStore(intValVar) = .Cells(i, 5).Value

intValVar = intValVar + 1

End If

Next

End With

Next wsh

MsgBox ("The Price is: " & WorksheetFunction.Max(intVStore()))

End Sub
Click to expand...
Regards

Claus B.
Click to expand...


This really seems to do the trick quite well.

I added this to list the items searched for and the price.

Range("K1") = Cells(i, 1) & " " & Cells(i, 2)_
& " " & Cells(i, 3) & " " & Cells(i, 4) ' Items
Range("K2") = intVStore() 'Price

Thanks again, Claus.

Regards,
Howard
 
C

Claus Busch

Hi Howard,

Am Thu, 15 Aug 2013 07:58:01 -0700 (PDT) schrieb Howard:
I added this to list the items searched for and the price.

Range("K1") = Cells(i, 1) & " " & Cells(i, 2)_
& " " & Cells(i, 3) & " " & Cells(i, 4) ' Items
Range("K2") = intVStore() 'Price
Click to expand...

if there are no items found you get a error message. For the result
change at the end of the code the line with the MsgBox:

If intValVar = 0 Then
MsgBox "No items found"
Exit Sub
Else
MsgBox "The Price is: " & WorksheetFunction.Max(intVStore())
End If


Regards
Claus B.
 
H

Howard

Hi Howard,



Am Thu, 15 Aug 2013 07:58:01 -0700 (PDT) schrieb Howard:








if there are no items found you get a error message. For the result

change at the end of the code the line with the MsgBox:



If intValVar = 0 Then

MsgBox "No items found"

Exit Sub

Else

MsgBox "The Price is: " & WorksheetFunction.Max(intVStore())

End If





Regards

Claus B.
Click to expand...
Gotcha, will do.

Thanks,
Howard
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Convert code to lookup three criteria return fourth 15
Loop Repeats - PLS HELP 2
Help needed Writing formula that totals data at end of column 7
FS epson receipt printer $99 , seiko label printers $49 symbol barcode guns $75 intermec wireless ba 0
FS PRINTER PARTS trays fusers drums printheads -- oki fujitsu hp genicom epson ibm dec jetdirect las 0
FS PRINTER PARTS trays fusers drums printheads -- oki fujitsu hp genicom epson ibm dec jetdirect las 3
HP color laser $299 includes jetdirect ethernet card - extra toners NEW $20, also hp 8500 $700 8550n 1
FS PRINTER PARTS trays fusers drums printheads -- oki fujitsu hp genicom epson ibm dec jetdirect las 1

Top