Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
lookup multiple search criteria but only return a value if both tr | Excel Worksheet Functions | |||
V lookup with 2 criteria to return results for multiple columns | Excel Worksheet Functions | |||
Return single value on multipl criteria lookup | Excel Worksheet Functions | |||
How do I lookup multilple criteria and return a single value | Excel Worksheet Functions | |||
Lookup Multiple Criteria return One answer | Excel Worksheet Functions |