PDA

View Full Version : [SOLVED] Doubt about Hlookup



Ricardo Rosa
04-29-2005, 02:31 AM
Hi,

i have a problem that the simple fuction of hlookup can?t solve. In the attachement file you can see the problem...
I want to to find a word in several rows and than return a number that is in always in the same row...


Please Help me...:banghead:

BlueCactus
04-30-2005, 10:19 PM
Not getting much love, eh?

Is this the sort of thing you're looking for:


Sub FindCK()
Dim flightNum As String, tableData As Variant, x As Integer, y As Integer
' Fetch table from sheet. Assumes the exact table dimensions in your example.
tableData = ActiveSheet.Cells(3, 3).Resize(35, 11).Value
' If your active cell is not in column "O" then question what you're doing
If ActiveCell.Column <> 15 Then
MsgBox "You sure you've selected the right cell?"
Exit Sub
End If
' Flight number comes from selected cell
flightNum = ActiveCell.Value
' Search table for flight number
For x = 1 To UBound(tableData, 2)
For y = 1 To UBound(tableData, 1)
If InStr(tableData(y, x), flightNum) Then
' Found it: enter CK number OF THAT COLUMN into adjacent cell
ActiveCell.Offset(0, 1).Value = tableData(1, x)
Exit Sub
End If
Next y
Next x
End Sub

To use:
1. Open your spreadsheet.
2. Press Alt+F11
3. Menu: Insert -> Module
4. Paste the above code in the new window.
5. Hit the excel icon button in the top toolbar (shoud be first button)


6. Now, select the flight number in column O.
7. Menu: Tools -> Macros... -> FindCK() -> Run

Caveats:
1. This works for a spreadsheet with the exact table dimensions used in your example, and for flight numbers in Column O.
2. Your example is ambiguous. The CK number shown in the example does not always correspond to the exact column containing the flight number. How do you know when you need to choose the CK number in the next column to the left? For example, LH 4537 has a CK number of 14 but is actually in the column corresponding to CK 15.

If this code works for you, there are ways of attaching it to a button on the sheet, or a keystroke, or other easier ways of running it.

Ricardo Rosa
05-02-2005, 03:36 AM
HI,

in the first place thanks for the reply... it works in perfection...

My example was not correct, LH 4545 should had CK 15 and not 14...

Now, i?m trying to expand your vba code to other aplications...

If i have any doubts... you will "see" me here very soon...:)

Thanks

:beerchug:

BlueCactus
05-02-2005, 07:05 AM
I'm glad it works for you. I'm going to mark this thread as solved, but feel free to keep the discussion going if you still have issues.

Ricardo Rosa
05-02-2005, 09:18 AM
Hello again,

i made a code to a bigger aplicattion and it works fine.
Now i have another question... It?s possible to make automatically the CK for all the flights ??

I?m going to send you another aplicattion with much more flights....

Thanks

BlueCactus
05-05-2005, 12:01 AM
OK, try this. No need to select a cell this time. Just run FindCK(). It'll find the outline of your table, collect all the flight numbers and CK numbers and dump them in two columns to the right of the table.

This code is a little messy and very simplistic (and I'm too tired to add line separators) because it's late and I don't have time to perfect it for you. But I think it works for the basic purpose you asked. We don't check for duplicate flights, and we don't sort the data.

Check the comments in the code carefully as they describe some of the limitations that are not accounted for.

Good luck!

Sub FindCK()
Dim flightNum As String, tableData As Variant, x As Integer, y As Integer, x1y1 As Variant, x2y2(1) As Variant
Dim colInd As Variant, flightList As Variant, flightCount As Integer

' Fetch some data from sheet. Assumes the top-left of table is within (100,100) of A1
tableData = ActiveSheet.Cells(1, 1).Resize(100, 100).Value

' Locate top-left of sheet by looking for 'Horas'
x1y1 = SearchData(tableData, "Horas")
' Couldn't find it
If x1y1(0) = 0 Then
MsgBox "Cannot locate top-left of table"
Exit Sub
End If

' Search for right of table by looking for last CK number
' Assume: CK in same row as 'Horas'. Cell one beyond last CK is blank. Less than 256 columns.
x2y2(1) = x1y1(1) + 1
Do While ActiveSheet.Cells(x1y1(0), x2y2(1) + 1) <> ""
x2y2(1) = x2y2(1) + 1
Loop

' Search for bottom of table by looking for last cell with same color as 'Horas' in that column.
' Assume: color changes at end of table. Less than ~65000 rows.
colInd = ActiveSheet.Cells(x1y1(0), x1y1(1)).Interior.ColorIndex
x2y2(0) = x1y1(0)
Do While ActiveSheet.Cells(x2y2(0) + 1, x1y1(1)).Interior.ColorIndex = colInd
x2y2(0) = x2y2(0) + 1
Loop

' Collect entire table
tableData = ActiveSheet.Cells(x1y1(0), x1y1(1)).Resize(x2y2(0) - x1y1(0), x2y2(1) - x1y1(0)).Value

' No flights found yet
flightCount = 0

For x = 1 To UBound(tableData, 2)
For y = 2 To UBound(tableData, 1)
If Len(tableData(y, x)) > 0 Then
' something in cell
If Not IsNumeric(Left(tableData(y, x), 1)) Then
' that something is a flight number
' Assume: flight num is first thing in cell. Nothing else non-numeric occupies first character in cell, and
' flight number contains exactly one space.
flightCount = flightCount + 1
If InStr(InStr(tableData(y, x), " ") + 1, tableData(y, x), " ") > 0 Then
' there's more text to the right of the flight number
flightNum = Left(tableData(y, x), InStr(InStr(tableData(y, x), " ") + 1, tableData(y, x), " ") - 1)
Else
' the flight number is the only text
flightNum = tableData(y, x)
End If
' output this flight info to sheet. Two columns to the right of the table.
ActiveSheet.Cells(x1y1(0) + flightCount - 1, x2y2(1) + 2).Value = flightNum
ActiveSheet.Cells(x1y1(0) + flightCount - 1, x2y2(1) + 3).Value = tableData(1, x)
End If
End If
Next y
Next x

End Sub

Function SearchData(ByRef tableData As Variant, ByRef searchStr As String) As Variant
Dim x As Integer, y As Integer

For x = 1 To UBound(tableData, 2)
For y = 1 To UBound(tableData, 1)
If InStr(tableData(y, x), searchStr) Then
SearchData = Array(y, x)
Exit Function
End If
Next y
Next x

SearchData = Array(0, 0)
End Function

Ricardo Rosa
05-06-2005, 02:20 AM
Hi again,

one more time, the VBA code works in perfection...

I don?t have many coments to say about the code, all i want to say is thank you very much...

My problem is solved

You are the best...

:beerchug: