Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Convert code to lookup three criteria return fourth

Code by Claus that looked up four items and returned a fifth item.

I need it to lookup three and return the fourth.

First item is in column B6:B500+-
Second is in column C same range
Third is in column D same range

and the return item is in column H same range as others.

Items 1 thru 4 will be on the same row.

I have made some change to the original code but to dense to get it to look for three return fourth.

The message box is good and M9, 10, 11 etc. are fine for a return targets at present.

Thanks.
Howard


Option Explicit
Option Compare Text

Sub Lookup_Four_Return_Fifth2_Claus()
'// Lookup three return fourth
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 Material:", "Material") & InputBox("Input Pipe Non. Diameter:", "Pipe Nom Dia") _
& InputBox("Input Pipe Press Class:", "Pipe Press Cls")

For Each wsh In ThisWorkbook.Worksheets

With wsh
lngLstRow = .UsedRange.Rows.Count

For i = 2 To lngLstRow

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

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

ReDim Preserve intVStore(intValVar)
intVStore(intValVar) = .Cells(i, 7).Value

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

intValVar = intValVar + 1
End If
Next

End With

Next wsh

If intValVar = 0 Then
MsgBox "No items found"
Exit Sub
Else
'MsgBox "The Price is: " & WorksheetFunction.Max(intVStore())
End If
End Sub
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default Convert code to lookup three criteria return fourth

Hi Howard,

Am Mon, 14 Oct 2013 04:49:52 -0700 (PDT) schrieb Howard:

First item is in column B6:B500+-
Second is in column C same range
Third is in column D same range

and the return item is in column H same range as others.


for maximum price in K2:

Sub Lookup_Four_Return_Fifth2_Claus()
'// Lookup three return fourth
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 Material:", "Material") & InputBox("Input Pipe
Non. Diameter:", "Pipe Nom Dia") _
& InputBox("Input Pipe Press Class:", "Pipe Press Cls")

For Each wsh In ThisWorkbook.Worksheets

With wsh
lngLstRow = .UsedRange.Rows.Count
For i = 6 To lngLstRow
str2 = .Cells(i, 2) & .Cells(i, 3) & _
.Cells(i, 4)
If StrComp(str1, str2, 1) = 0 Then
ReDim Preserve intVStore(intValVar)
intVStore(intValVar) = .Cells(i, 8).Value

Range("K1") = .Cells(i, 2) & " " & .Cells(i, 3) & " " & _
.Cells(i, 4)
intValVar = intValVar + 1
End If
Next
End With

Next wsh

If intValVar = 0 Then
MsgBox "No items found"
Exit Sub
Else
Range("K2") = WorksheetFunction.Max(intVStore())
End If
End Sub


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Convert code to lookup three criteria return fourth

Worked fine with the return on the same sheet as the code is in.

I changed it to read out on another worksheet and that seems to work just fine also!!

Thanks Claus.

Regards,
Howard
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default Convert code to lookup three criteria return fourth

Hi Howard,

Am Mon, 14 Oct 2013 06:38:25 -0700 (PDT) schrieb Howard:

I changed it to read out on another worksheet and that seems to work just fine also!!


I don't know whether you want all found items, the max price or the min
price
So I adapted it to the existing code with the max


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Convert code to lookup three criteria return fourth

On Monday, October 14, 2013 7:03:47 AM UTC-7, Claus Busch wrote:
Hi Howard,



Am Mon, 14 Oct 2013 06:38:25 -0700 (PDT) schrieb Howard:



I changed it to read out on another worksheet and that seems to work just fine also!!




I don't know whether you want all found items, the max price or the min

price

So I adapted it to the existing code with the max





Regards

Claus B.


The fourth item to be returned is a single measurement such as 308.25, so I don't think the max or min are relevant. But I have to admit I am lost on the min or max.

I do want the three criteria and of course the fourth item to be listed, which it does nicely. So is that the Max as you have mentioned?

It is working fine, although the fourth item is a bit slow to be listed. A few second, which I believe is okay, given the 500 +/- rows.

The input box items pop right up, no problem.

Howard


  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default Convert code to lookup three criteria return fourth

Hi Howard,

Am Mon, 14 Oct 2013 08:51:16 -0700 (PDT) schrieb Howard:

The fourth item to be returned is a single measurement such as 308.25, so I don't think the max or min are relevant. But I have to admit I am lost on the min or max.

I do want the three criteria and of course the fourth item to be listed, which it does nicely. So is that the Max as you have mentioned?

It is working fine, although the fourth item is a bit slow to be listed. A few second, which I believe is okay, given the 500 +/- rows.


there could be more than one found strings and the array is filled with
all found items. At the moment you get the max(Array).


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2
  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default Convert code to lookup three criteria return fourth

Hi Howard,

Am Mon, 14 Oct 2013 08:51:16 -0700 (PDT) schrieb Howard:

It is working fine, although the fourth item is a bit slow to be listed. A few second, which I believe is okay, given the 500 +/- rows.


please try this version (You have to modify the output range)
It is a bit faster:

Sub Test()
Dim lngLstRow As Long
Dim str1 As String, str2 As String, str3 As String
Dim strTotal As String, str4 As String
Dim i As Long
Dim n As Long
Dim varIn() As Variant
Dim varout() As Double
Dim wsh As Worksheet
Dim st As Double



str1 = InputBox("Input Material:", "Material")
str2 = InputBox("Input PipeNon. Diameter:", "Pipe Nom Dia")
str3 = InputBox("Input Pipe Press Class:", "Pipe Press Cls")
strTotal = str1 & str2 & str3
st = Timer
For Each wsh In ThisWorkbook.Worksheets
With wsh
lngLstRow = .Cells(.Rows.Count, 2).End(xlUp).Row
varIn = .Range("B6:H" & lngLstRow)
For i = LBound(varIn) To UBound(varIn)
str4 = varIn(i, 1) & varIn(i, 2) & varIn(i, 3)
If StrComp(strTotal, str4, 1) = 0 Then
ReDim Preserve varout(n)
varout(n) = varIn(i, 7)
n = n + 1
End If
Next
End With
Next
[K1] = str1 & " " & str2 & " " & str3
[K2] = WorksheetFunction.Max(varout)
MsgBox Format(Timer - st, "0.000")
End Sub


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2
  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Convert code to lookup three criteria return fourth

It is a bit faster:



Sub Test()

Dim lngLstRow As Long

Dim str1 As String, str2 As String, str3 As String

Dim strTotal As String, str4 As String

Dim i As Long

Dim n As Long

Dim varIn() As Variant

Dim varout() As Double

Dim wsh As Worksheet

Dim st As Double


str1 = InputBox("Input Material:", "Material")

str2 = InputBox("Input PipeNon. Diameter:", "Pipe Nom Dia")

str3 = InputBox("Input Pipe Press Class:", "Pipe Press Cls")

strTotal = str1 & str2 & str3

st = Timer

For Each wsh In ThisWorkbook.Worksheets

With wsh

lngLstRow = .Cells(.Rows.Count, 2).End(xlUp).Row

varIn = .Range("B6:H" & lngLstRow)

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

str4 = varIn(i, 1) & varIn(i, 2) & varIn(i, 3)

If StrComp(strTotal, str4, 1) = 0 Then

ReDim Preserve varout(n)

varout(n) = varIn(i, 7)

n = n + 1

End If

Next

End With

Next

[K1] = str1 & " " & str2 & " " & str3

[K2] = WorksheetFunction.Max(varout)

MsgBox Format(Timer - st, "0.000")

End Sub


Regards

Claus B.


Wow! Yes indeed, a lot faster!

Many thanks, Claus.

Regards,
Howard
  #9   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Convert code to lookup three criteria return fourth

Hi Claus,

I am trying to incorporate an error catcher similar to the one in the previous code, but alas, I can't sort out the equivalent of "If intValVar = 0 Then" in the new faster code.

If intValVar = 0 Then
MsgBox "No items found"
Exit Sub
Else

Sheets("Darcy-Weisbach").Range("F6") = WorksheetFunction.Max(intVStore())
End If

Thanks.

Howard
  #10   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default Convert code to lookup three criteria return fourth

Hi Howard,

Am Mon, 14 Oct 2013 13:04:20 -0700 (PDT) schrieb Howard:

I am trying to incorporate an error catcher similar to the one in the previous code, but alas, I can't sort out the equivalent of "If intValVar = 0 Then" in the new faster code.

If intValVar = 0 Then
MsgBox "No items found"
Exit Sub
Else

Sheets("Darcy-Weisbach").Range("F6") = WorksheetFunction.Max(intVStore())
End If


try:
Sub Test()
Dim lngLstRow As Long
Dim str1 As String, str2 As String, str3 As String
Dim strTotal As String, str4 As String
Dim i As Long
Dim n As Long
Dim varIn() As Variant
Dim varOut() As Double
Dim wsh As Worksheet

str1 = InputBox("Input Material:", "Material")
str2 = InputBox("Input PipeNon. Diameter:", "Pipe Nom Dia")
str3 = InputBox("Input Pipe Press Class:", "Pipe Press Cls")
strTotal = str1 & str2 & str3
For Each wsh In ThisWorkbook.Worksheets
With wsh
lngLstRow = .Cells(.Rows.Count, 2).End(xlUp).Row
varIn = .Range("B6:H" & lngLstRow)
For i = LBound(varIn) To UBound(varIn)
str4 = varIn(i, 1) & varIn(i, 2) & varIn(i, 3)
If StrComp(strTotal, str4, 1) = 0 Then
ReDim Preserve varOut(n)
varOut(n) = varIn(i, 7)
n = n + 1
End If
Next
End With
Next
If n = 0 Then
MsgBox "No items found"
Exit Sub
Else
Sheets("Darcy-Weisbach").Range("F6") = WorksheetFunction.Max(varOut)
End If
End Sub


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2


  #11   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Convert code to lookup three criteria return fourth


Okay, thanks, I'll give that a try with much confidence.

And why would I get a Type mismatch error if I wanted the option to define the three search strings from cell references (drop downs).

str2 is a number, 40, 125, 60 etc. but is accepted as a string from the input box.
The values in the drop down are identical to the values entered into the input boxes...?

str1 = Range("C5").Value
str2 = Range("D5").Value
str3 = Range("E5").Value

Howard
  #12   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default Convert code to lookup three criteria return fourth

Hi Howard,

Am Mon, 14 Oct 2013 13:55:22 -0700 (PDT) schrieb Howard:

str2 is a number, 40, 125, 60 etc. but is accepted as a string from the input box.
The values in the drop down are identical to the values entered into the input boxes...?


for me it works with numbers
But try changing .value to .text


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2
  #13   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Convert code to lookup three criteria return fourth

for me it works with numbers

But try changing .value to .text


Regards

Claus B.


Here is what my attempt looks like, I wasn't getting the error before I went to cell references, so that is why I guess it has to do with my changes.

I did make a change to return the results to two pages, and that works just fine.

Howard

Option Explicit
Option Compare Text

Sub TestClausDropDown()
Dim lngLstRow As Long
Dim str1 As String, str2 As String, str3 As String
Dim strTotal As String, str4 As String
Dim i As Long
Dim n As Long
Dim varIn() As Variant
Dim varOut() As Double
Dim wsh As Worksheet
Dim st As Double

str1 = Range("C5").Text
str2 = Range("D5").Text
str3 = Range("E5").Text

'str1 = InputBox("Input Material:", "Material")
'str2 = InputBox("Input PipeNon. Diameter:", "Pipe Nom Dia")
'str3 = InputBox("Input Pipe Press Class:", "Pipe Press Cls")

strTotal = str1 & str2 & str3
st = Timer

For Each wsh In ThisWorkbook.Worksheets
With wsh

lngLstRow = .Cells(.Rows.Count, 2).End(xlUp).Row
varIn = .Range("B6:H" & lngLstRow)
For i = LBound(varIn) To UBound(varIn)
str4 = varIn(i, 1) & varIn(i, 2) & varIn(i, 3)
If StrComp(strTotal, str4, 1) = 0 Then
ReDim Preserve varOut(n)
varOut(n) = varIn(i, 7)
n = n + 1
End If
Next
End With
Next

Sheets("Darcy-Weisbach").Range("F5") = str1 & " " & str2 & " " & str3
[O2] = str1 & " " & str2 & " " & str3
Sheets("Darcy-Weisbach").Range("F6") = WorksheetFunction.Max(varOut)
[P2] = WorksheetFunction.Max(varOut)
MsgBox Format(Timer - st, "0.000")
End Sub
  #14   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default Convert code to lookup three criteria return fourth

Hi Howard,

Am Mon, 14 Oct 2013 14:18:15 -0700 (PDT) schrieb Howard:

Here is what my attempt looks like, I wasn't getting the error before I went to cell references, so that is why I guess it has to do with my changes.


I only get an error if no items are found. Therefore try the
IF-statemant:

If n = 0 Then
MsgBox "No items found"
Else
Sheets("Darcy-Weisbach").Range("F5") = str1 & " " & str2 & " " & str3
[O2] = str1 & " " & str2 & " " & str3
Sheets("Darcy-Weisbach").Range("F6") = WorksheetFunction.Max(varOut)
[P2] = WorksheetFunction.Max(varOut)
End If


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2
  #15   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Convert code to lookup three criteria return fourth


Or another way to make it work IS TO PUT IT IN A STANDARD MODULE.

Sometimes I think there is no hope for me.

Sorry, Claus for all the trouble, that sure seems to be a bad habit of mine not using a standard module.

Thanks, and again, I'm sorry.

Regards
Howard


  #16   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default Convert code to lookup three criteria return fourth

Hi Howard,

Am Mon, 14 Oct 2013 15:04:04 -0700 (PDT) schrieb Howard:

Or another way to make it work IS TO PUT IT IN A STANDARD MODULE.


no matter, I am always glad to help.
Fine, that it is working now. Thank you for the feedback.
Good night.


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2
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
lookup multiple search criteria but only return a value if both tr se7098 Excel Worksheet Functions 8 October 7th 08 10:11 PM
V lookup with 2 criteria to return results for multiple columns JenL Excel Worksheet Functions 2 September 20th 07 10:04 PM
Return single value on multipl criteria lookup maplesugarsnow Excel Worksheet Functions 3 July 1st 06 01:03 PM
How do I lookup multilple criteria and return a single value StephenAccountant Excel Worksheet Functions 1 June 9th 06 03:23 AM
Lookup Multiple Criteria return One answer cbanks Excel Worksheet Functions 3 January 26th 06 09:00 PM


All times are GMT +1. The time now is 03:10 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"