Looking data up on a complex grid with VBA 1

[Qazzart]

Good afternoon everyone,

I would like to set up a macro, I have some experience in visual basic, so I know the steps that I would take to create this macro, I just don't know how to search through a column or a row for a specific value, then to save only the value identifying only that column or that row.

I've worked out my steps, just need some help with the lines.

From worksheet #1, it will count how many columns are in a specific row.
Then starting from the first column, it will remember three fields. (A, B C and D). Using those variables, it will find what goes in line E from a table on a different worksheet.

Open the second worksheet (from a share server).

It will then need to search as follows...

1. Search through row 58 (specifically from A58 to BT58) and find a specific value to match to value A. (lets call it "X") we will need to remember only the column that "X" is in.
2. Match for "B". (B can either be yes or no)
3. if “Yes” then set the Column to A (A58), if “No” then the column to B (B58) having the value of “No” shifts the column with the data needed over one to the right.)
4. Search that column for the value to match for C. (Lets call these G, H, and I) and remember that row.
5. Search that same column for another value to match to D ( this will be a decimal number) and remember that row.
6. for the row with the G, H, or I (from line 4) search across that Row for another value (x, y or z) remember that column.
7. match the column from line 6 and the row for line 5 and go to that Cell. copy and paste the value of that cell to line E from the parent worksheet.
8. go to the next column and repeat the above steps until all columns have been filled in with value E.

I know it is all very confusing.

I wish I could upload the layout of the table, that would clear things up, but I’m at work and cannot.

The table is several tables in one.
Think of it like a plus sign, the bottom left will tell you what row will have your answer. The top left will refine that row down even more (for every four in the bottom left, the top left has one.) the top right gives you the column you need to be in for your answer. The answer block is the bottom right.

If your totally confused, then your in the right spot… cause that’s how it is.. (and this is why I would like to create a macro to help me find my answer, and to help me reduce mistakes. )

Here is what I have to begin with...
I would like for it to update as data changes from within the cells that fill in the fields A B C and D.. I don't know how to do that ether, so for now it will run from clicking a button.

Function TableLookup ()
On Error Resume Next
Workbooks("Test.xls").Activate
RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
For i = 2 To RowCount
Range("a" & i).Select
Aa = ActiveCell.Value
Bb = ActiveCell.Offset(0, 1).Value
Cc = ActiveCell.Offset(0, 2).Value
Dd = ActiveCell.Offset(0, 3).Value

Workbooks("Table0026.xls").Activate

'this is where I need help
'the value will be set to "Ee"

Workbooks("Test.xls").Activate
Range("a" & i).Select
ActiveCell.Offset(0, 4).Value = Ee

Next
End Function

Any help would be very much appreciated
Thank you all!!

Qazzart.

 

[SkipVought]

I gould a glitch, but it only affects the result...

Function LKUP(f1, f2, f3, f4, f5) As Single
'f1 is a value (A,B,C...) in the Field1 Range
'f2 is a value (Yes,No) in the Field2 Range
'f3 is a value (1/3,1/2...) in the Field3 Range
'f4 is a value (AAT,TGA...) in the Field4 Range
'f5 is a value (D,E,F...) in the Field5 Range
'Field6 is the range defining the DECIMAL NUMBERS, _
    one of which, this function returns
'these Fields must be Named Ranges, defining each data area of the table
    Dim r1 As Range, r2 As Range, r3 As Range, r4 As Range, r5 As Range
    Dim off3
    
    LKUP = 0#
    
    'Field4 has merged cells--must use MergeArea
    Set r4 = [Field4].Find(f4)
    
    If Not r4 Is Nothing Then
        'Field2 has merged cells--must use MergeArea
        Set r2 = Intersect(r4.MergeArea.EntireColumn, [Field2]).Find(f2)
        
        If Not r2 Is Nothing Then
            '[b]I added this statement because the FIND was not returning the correct range
            off3 = Application.Match(f3, Intersect(r4.EntireColumn, [Field3]), 0)   '[/b]
            Set r3 = Intersect(r4.MergeArea.EntireColumn, [Field3])(off3 * 2)
            
            If Not r3 Is Nothing Then
                Set r1 = Intersect(r2.EntireColumn, [Field1]).Find(f1)
                
                If Not r1 Is Nothing Then
                    Set r5 = Intersect(r1.EntireRow, [Field5]).Find(f5)
                    
                    If Not r5 Is Nothing Then
                        LKUP = Intersect(r3.EntireRow, r5.EntireColumn).Value
                    End If
                End If
            End If
        End If
    End If
    
    Set r1 = Nothing
    Set r2 = Nothing
    Set r3 = Nothing
    Set r4 = Nothing
    Set r5 = Nothing
End Function

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Qazzart]

Field1 =Sheet2!$BN$69:$EG$78
Field2 =Sheet2!$BN$79:$EG$79
Field3 =Sheet2!$BN$80:$EG$124
Field4 =Sheet2!$BN$125:$EG$125
Field5 =Sheet2!$EH$69:$ES$78
Field6 =Sheet2!$EH$80:$ES$124

 

[SkipVought]

Your ranges seem as if they are defined properly.

I can also run my version from my PERSONAL.XLS workbook.

So there must be another problem.

Short of posting your workbook again, lets try some debugging.

Make sure you have the latest version, posted today at 30 Apr 10 11:04

alt+F11 to your module.

Put a [highlight]BREAK[/highlight] on

Function LKUP(f1, f2, f3, f4, f5) As Single
'f1 is a value (A,B,C...) in the Field1 Range
'f2 is a value (Yes,No) in the Field2 Range
'f3 is a value (1/3,1/2...) in the Field3 Range
'f4 is a value (AAT,TGA...) in the Field4 Range
'f5 is a value (D,E,F...) in the Field5 Range
'Field6 is the range defining the DECIMAL NUMBERS, _
    one of which, this function returns
'these Fields must be Named Ranges, defining each data area of the table
    Dim r1 As Range, r2 As Range, r3 As Range, r4 As Range, r5 As Range
    Dim off3
    [highlight]
    LKUP = 0#[/highlight]

EDIT the cell containing your LKUP function and hit ENTER. Your code will run to the [highlight]BREAK[/highlight].

STEP (F8) thru each statement and report back with your observations.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Qazzart]

Skip,

Sorry it took so long to get back with you, I've had a busy day...

okay, so I'm home now and now I'm reconstructing the worksheets from work from printouts... I might be at this for a while, when I'm done, Ill upload the forms to the site so that you can tell me what I'm doing wrong here...

At work I'm using the very friendly Excel 2003, at home I'm using 2007 (yeah, what was I thinking when I bought this?? Nothing is the same, takes forever to find basic things... absolutely frustrating!)

Give me a few hours and Ill have everything uploaded with another post.

Qazzart

 

[Qazzart]

Skip!!

Your the greatest! I dont know what I did previous, but when I remade the entire thing here at home, it works like a champ.

I aspire one day to actually understand how you came up with this function, its quite far beyond my abilities.

I think what I need to do at work is just rebuild my spreadsheet from scratch as its quite messy, and that could be why I wasn't able to make it work.

When you get a chance, could you explain in lay terms how you came up with this. I know I would very much like to learn your methods, and possibly quite a few others that have read this thread, or will in the future.

Thanks a bunch!

Qazzart