Complex list lookup macro

Originally Posted by Engineerpete

Route Mileage
ABC 123.4567
DEF 89.1011

Route Start Mile End Mile Cat
ABC 120.0099 125.1011 2
ABC 118.1000 125.1011 1
ABC 125.1011 129.0000 3
DEF 85.0000 95.0000 4
DEF 87.1500 90.1000 3

So the result would be
Route Mileage Cat
ABC 123.4567 1
DEF 89.1011 3

Because the result for DEF is cat 4 I assume it's the lowest mileage based on end mile - is this correct? Or is it based on end mile minus start mile?

Andrew,

The first 'table' is what I am trying to populate using the second 'table'. I have specific mileages in table one which fall into 'bands' on table two where the 'cat' is. The 'cat' is not based specifically on the upper or lower mileage. I have the macro so that it goes and places a 'cat' against the specific mileage for each site from the bands however it does not recognise when there is a second possible band with a different cat available.

Hope that makes sense!

Yes, I understand that the first table is what you're trying to populate, what I'm asking is whether the "lowest" is selected by subtracting the start mile from the end mile.

Anyway, if it is, then try this function:

Function FindLowest(MileCode, TableRange As Range) As Integer

Const TableSearchCol = 1

Dim FindMile As Range
Dim Lowest, FirstAddress
Dim StartMile, EndMile
Dim Cat
Dim CompareValue

Lowest = -1

Set FindMile = TableRange.Columns(TableSearchCol).Find(MileCode)

If Not FindMile Is Nothing Then

  FirstAddress = FindMile.Address
  
  While Not FindMile Is Nothing
    StartMile = FindMile.Offset(0, 1).Value
    EndMile = FindMile.Offset(0, 2).Value
    
    CompareValue = Abs(EndMile - StartMile)
    
    If Lowest = -1 Then
      Lowest = CompareValue
      Cat = FindMile.Offset(0, 3).Value
    Else
      If CompareValue < Lowest Then
        Lowest = CompareValue
        Cat = FindMile.Offset(0, 3).Value
      End If
    End If
    
    Set FindMile = TableRange.Columns(TableSearchCol).FindNext(FindMile)
    
    If FindMile.Address = FirstAddress Then
      Set FindMile = Nothing
    End If
  Wend

  FindLowest = Cat

Else

  FindLowest = 0
  
End If

End Function

If you call it from a macro you have to pass it parameters and it will return a value, for example, if your table 2 was on sheet 2 in cells A2:D6 to return the 'best' cat for DEF you'd say:

BestCat=FindLowest("DEF",sheets(2).range("A2:D6"))

This should also work as a worksheet function, but for some reason it's not. I think Excel suspects me of trying to alter cell values from a UDF.

We are trying to populate using the lowest 'cat' value for which the 'site' mileage falls into the banding if that makes sense.

From the attached spreadsheet the value entered into cell C2 will be '1' because for the route ABC at mileage 123.457 whilst it falls between both rows 2 and 3 the lower 'cat' value given in column F is '1'. Row 4 is not considered for this 'site' because the mileage boundaries do not include it.

Similarly for cell C3 the value is '3' because both DEF entries (rows 5 and 6) include the site mileage.

Apologies if I still havent understood your question and I still havent explained what I am after clearly.

Thanks again

OK, so just see if I've got this straight.

You have a route code with a mileage.

On your data table you want to find the cat code that corresponds to the lowest value of End Miles - Start Miles, where the range of miles between start and end incorporates the mileage from table 1.

Is that correct?

If so my original code just needs a little tweak.

Function FindLowest(MileCode, Mileage, TableRange As Range) As Integer

Const TableSearchCol = 1

Dim FindMile As Range
Dim Lowest, FirstAddress
Dim StartMile, EndMile
Dim Cat
Dim CompareValue

Lowest = -1

Set FindMile = TableRange.Columns(TableSearchCol).Find(MileCode)

If Not FindMile Is Nothing Then

  FirstAddress = FindMile.Address
  
  While Not FindMile Is Nothing
    StartMile = FindMile.Offset(0, 1).Value
    EndMile = FindMile.Offset(0, 2).Value
    
    CompareValue = Abs(EndMile - StartMile)
    
   If StartMile=<Mileage And EndMile=> Mileage Then

      If Lowest = -1 Then
        Lowest = CompareValue
        Cat = FindMile.Offset(0, 3).Value
      Else
        If CompareValue < Lowest Then
          Lowest = CompareValue
          Cat = FindMile.Offset(0, 3).Value
        End If
      End If
    
   End If

    Set FindMile = TableRange.Columns(TableSearchCol).FindNext(FindMile)
    
    If FindMile.Address = FirstAddress Then
      Set FindMile = Nothing
    End If
  Wend

  FindLowest = Cat

Else

  FindLowest = 0
  
End If

End Function

So you'll now have to pass the function 3 parameters - to get the lowest cat code for ABC call:

BestCat=FindLowest("ABC",123.456,sheets(2).range("A2:D6"))

Thanks Andrew, its getting closer but not quite there.

We are after the lowest value of the 'cat' code at the specific mileage. Hence if we have two mileage bands (for the same route) that are the same but the 'cat' code for one of them is '2' and the other '4', the returned result is '2'.

Does this make sense?

Thanks

Yes. No problem. In my last block of code change the line

CompareValue = Abs(EndMile - StartMile)

To ...

CompareValue = FindMile.Offset(0, 3).Value

and Bob's your auntie's 'special friend'.

Andrew,

I am still having a few problems with it - probably down to my rusty skills at code writing but having entered your code into the VB editor and click 'run' a new window opens asking for a macro name - what do I do here?

Thanks

My code is a function rather than a sub, so you can't run it directly from the macro list.

Create a new sub ...

Sub Demonstrate()

Msgbox FindLowest("ABC",123.456,ThisWorkbook.Sheets(2).Range("A2:D6"))

End Sub

Change the Sheet and range reference to match where your lookup table actually is and then run the macro "Demonstrate"

Sorry Andrew but I am still not getting it. Where do I paste that in in relation to the rest of the code as currently I can only get it to return a message box with a value of 0?

Should I not have written the code you gave in the VB editor?

Yes. If you've already got a code module then just paste all of the code I gave you into that.

If not then create a module by selecting "Insert|Module" from the VB code editor screen.

It actually sounds like the code is working - it returns 0 if it can't find the value you're looking for in the first column of the range you gave it. Did you point it to the right sheet and range for your look-up table (the one you called Table 2 in your earlier posts)?

Thanks Andrew - I think it is working however am I right in thinking that the numbers refer to the columns eg 'FindMile.Offset(0, 1).Value' refers to columns A and B for instance? So I need to renumber these with the correct columns refered to in my spreadsheet?

Thanks

You pass it a range which contains your lookup (table 2).

It looks in the first column for a match for the mileage code, e.g. "ABC"

The .offset then determines where it looks for the rest of the data, so .Offset(0,1) means same row, but one column to the right, .Offset(0,2) is 2 columns to the right, etc.

So, yes, if your table is in a different format to that which you posted you'll have to change the offset lines to accomodate this.

Andrew, I have the same format as in the example workbook uploaded in post 5 - using the same columns just with alot more rows! I am still the the message box with 0 for this when I run it!

OK, I've added my code to your example workbook and attached it to this post. It's working fine for me. Try it out and see how it goes for you.

Yep thanks Andrew - just struggling now to get it to print into the "new" 'cat' cells (column C) and continue down the list to the end of the 7000+ sites!

Sub DoItAll

Dim TableRange as Range
Dim RowLoop 

With ThisWorkbook.Sheets(1)
  Set TableRange=.Range("H2:K6")

  RowLoop=2
  While .Cells(RowLoop,1).Value<>""
      Cells(RowLoop,3).Value=FindLowest(.Cells(RowLoop,1).Value,.Cells(RowLoop,2).Value, TableRange)
   RowLoop=RowLoop+1

   Wend

End With

End Sub

Adjust to suit actual location of tables, etc. and job's a good 'un.

Andrew many thanks for all your help with this. It works however I still have a number of 'sites' (about 240 of 4500) that have 0 populated by the code into the cat column. I know a number of the bandings were blank so I changed the 0 to a 10 in the last part of your code (Else FindLowest = 0 to =10) and this has highlighted those that have no cat code in the lookup list.

Manually looking I can see that there are cat codes in the lookup table for the ones that now are populated with 0 but cant work out why! Any ideas?

Cheers

Are there cat codes where the mileage falls between the start and end miles?

Actually, thinking about it, if it's returning 0 rather than 10 that means that it is finding the matches, but discounting them, because the mileage falls outside the start and end miles, as per your requirement in post #10.

It returns 10 for where there is a missing cat code - these all at a glance tie up and are only to be highlighted.

Where it returns 0 a cat code exists for the specific mileage (even several possible codes exist) dispite other 'sites' completing correctly when more than 2 possible cat codes exist.

In that case is the mileage code exactly correct? If it has leading or trailing spaces, or any other information in the code cell it will stop the search working properly. Could you try re-typing one of them in table 1 and see if it can find it then?

Hi Andrew many thanks again for your help with this.

I have tried re-typing the codes and mileages but it still returns 0.

I am off on holiday this morning so I think that the guys doing the actual work on the spreadsheet may just have to manually enter these 200 as I dont think I can sort it in the next 30mins but I will be back in a weeks time to try and get it sorted purely for future use!

Thanks again

Could you paste some of the codes it's returning 0 for and some of the places they appear in the lookup table and the code so far into an example workbook and post it?

I'm sure the issue is a trivial one, but without being able to run through a de-bug it's really difficult for me to diagnose it.

Andrew, attached is a sample of the problem 'sites'. Sorry I havent managed to copy the code in as I am now in very much of a rush to get out of the house and I havent worked out where to do it in the version of excel on this machine! But I have simply copied in the code you generously supplied.

Thanks again and will likely be back in a week!

Fixed. The issue was with blank cat code cells in the lookup table. It now ignores these.

Function FindLowest(MileCode, Mileage, TableRange As Range) As Integer

Const TableSearchCol = 1

Dim FindMile As Range
Dim Lowest, FirstAddress
Dim StartMile, EndMile
Dim Cat
Dim CompareValue

Lowest = -999

Set FindMile = TableRange.Columns(TableSearchCol).Find(MileCode)

If Not FindMile Is Nothing Then

  FirstAddress = FindMile.Address
  
  While Not FindMile Is Nothing
    StartMile = FindMile.Offset(0, 1).Value
    EndMile = FindMile.Offset(0, 2).Value
    
    CompareValue = FindMile.Offset(0, 3).Value
    
    If CompareValue <> "" Then
      If StartMile <= Mileage And EndMile >= Mileage Then

        If Lowest = -999 Then
          Lowest = CompareValue
          Cat = FindMile.Offset(0, 3).Value
        Else
          If CompareValue < Lowest Then
            MsgBox FindMile.Row
            Lowest = CompareValue
            Cat = FindMile.Offset(0, 3).Value
          End If
        End If
    
     End If
     
   End If

    Set FindMile = TableRange.Columns(TableSearchCol).FindNext(FindMile)
    
    If FindMile.Address = FirstAddress Then
      Set FindMile = Nothing
    End If
  Wend

  FindLowest = Cat

Else

  FindLowest = 0
  
End If

End Function