Using a Variable array in place of a Vlookup to return values to VBA code

[miless2111s]

I have a set of sheets which contain data which I pull into my VBA code with vlookups. The input data is collected into a table of data 10 columns wide, the key field is always an integer between 1 and 3000 but depending on the data entered by the users I might have 5 entries or 3000. The code loops through all integers 1 to 3000 an inspects the data table, if the integer isn't found it returns a default set of values but if the integer is found the values in the table are used by the code and a range of values are generated.

Is a Vlookup an efficient method? I read somewhere that it might not be and if not should I be using a Variable Array? I have worked out how I can read the input data into an 2D array however I am unsure how I
1) Read down the 1st column of the 2d array to see if the integer value is there (if not return default values)
2) Locate the right "row" in the array and pull out each individual data item into various calculations

I also wonder if outputting an array might be more efficient that my current method which writes out each result cell by cell (the output from the entire code is 2,500 rows of 31 columns of data which couldn't be output in one array but maybe 2,500 array writes would be faster than 77K individual write operations?

Many thanks in advance

Miles

 

[miless2111s]

Diddi
How do I pull a specific data point for a given Index value - so for instance column 10 for the index value 3?
Many thanks
Miles

 

[diddi]

can i verify that the code i provided does as you expected. if you have modified it could you post it so i understand where i am working from pls. then we can sort out your next feature

 

[miless2111s]

can i verify that the code i provided does as you expected. if you have modified it could you post it so i understand where i am working from pls. then we can sort out your next feature

Diddi
I am starting to understand arrays from your example, thank you. A couple of quesitons:
* Is there no need to declare / define the function names for each the array?
* is it "allowed" to have empty slots in an array so that the output doesn't put anything into the matching cell? If so how do you handle this?

The example I gave was a highly simplified model to give context to my questions however as you prefer to work with full solutions I will need to produce a more complex model. I obviously can't share the full code set as I have a lot of inputs and calcs etc which will only get in the way of my understanding of arrays and their functions, and posting 2.5K lines of code is a waste of your time. I will produce a more complex model with my current methods so you can see what I am trying to do at a smaller scale. I suspect this will better fit your preferred approach.

Many thanks for your help.

Miles

 

[diddi]

you can link a dropbox here so i can see what is going on more clearly.

 

[miless2111s]

you can link a dropbox here

 

[miless2111s]

I've sent you a PM with the link. The code is

Sub Calcs()
Dim Input2 As Range
Dim Input_Data As Range
Dim Colours As Range
Dim Output As Range
Dim Count_Ref As Integer
Dim wb As Workbook
Dim ws As Worksheet
Dim OutputRow As Integer
Dim Colour As String
Dim Foreground As String
Dim Text As String
Dim Val_1 As String
Dim Val_2 As String
Dim Val_3 As String
Dim Ref As String
Dim Name As String


Application.ScreenUpdating = False
On Error GoTo ErrHandle:
Error_msg = ""

Set wb = ActiveWorkbook
Set ws = wb.Sheets("output")

'set ranges
Set Input2 = Worksheets("Input 2").Range("Input2")
Set Input_Data = Worksheets("data").Range("Input_data")
Set Colours = Worksheets("Colours").Range("Colours")
Set Output = Worksheets("output").Range("a1:G31")

OutputRow = 2

For Count_Ref = 1 To 5
    Ref = Count_Ref
    Error_msg = "Doing calcs for " & Count_Ref
    'check if Ref is in data set AND has a y against it in the Input 2 sheet, if not return default values
    If IsError(Application.VLookup(Count_Ref, Input_Data, 1, False)) Or Not (Application.VLookup(Count_Ref, Input2, 2, False) = "y") Then
        'Default values
        Name = "blank 1-5"
        Foreground = "RGB(255,255,255)"
        Text = "RGB(255,0,0)"
        Val_1 = "10 mm"
        Val_2 = "5 mm"
        Val_3 = 1
        
    Else
        'Do Calcs for 1-5
        Name = Application.VLookup(Count_Ref, Input_Data, 2, False)
        Colour = Application.VLookup(Count_Ref, Input_Data, 3, False)
        If IsError(Application.VLookup(Colour, Colours, 1, False)) Then Colour = "unknown" Else Colour = Colour
        Foreground = Application.VLookup(Colour, Colours, 2, False)
        Text = Application.VLookup(Colour, Colours, 3, False)
        Val_1 = Application.VLookup(Count_Ref, Input_Data, 4, False) * 2 & " mm"
        Val_2 = Application.VLookup(Count_Ref, Input_Data, 5, False) * 1 & " mm"
        Val_3 = Application.VLookup(Count_Ref, Input2, 3, False)
    End If
    
    'Enter Values in output
    PrintOutput ws, "a", OutputRow, Ref
    PrintOutput ws, "b", OutputRow, Name
    PrintOutput ws, "c", OutputRow, Foreground
    PrintOutput ws, "d", OutputRow, Text
    PrintOutput ws, "e", OutputRow, Val_1
    PrintOutput ws, "f", OutputRow, Val_2
    PrintOutput ws, "g", OutputRow, Val_3
    
    OutputRow = OutputRow + 1

Next Count_Ref

For Count_Ref = 6 To 10
    Ref = Count_Ref
    Error_msg = "Doing calcs for " & Count_Ref
    'check if Ref is in data set AND has a y against it in the Input 2 sheet, if not return default values
    If IsError(Application.VLookup(Count_Ref, Input_Data, 1, False)) Or Application.VLookup(Count_Ref, Input2, 1, False) = "" Then
        'Default values
        Name = "blank 6-10"
        Foreground = "RGB(255,255,255)"
        Text = "RGB(255,0,0)"
        Val_1 = "10 mm"
        Val_2 = "5 mm"
        Val_3 = 1
    Else
        'Do Calcs for 6-10
        Name = Application.VLookup(Count_Ref, Input_Data, 2, False)
        Colour = Application.VLookup(Count_Ref, Input_Data, 3, False)
        If IsError(Application.VLookup(Colour, Colours, 1, False)) Then Colour = "unknown" Else Colour = Colour
        Foreground = Application.VLookup(Colour, Colours, 2, False)
        Text = Application.VLookup(Colour, Colours, 3, False)
        Val_1 = Application.VLookup(Count_Ref, Input_Data, 4, False) * 1.5 & " mm"
        Val_2 = Application.VLookup(Count_Ref, Input_Data, 5, False) * 1 & " mm"
        Val_3 = Application.VLookup(Count_Ref, Input2, 3, False)
    End If
    
    'Enter Values in output
    PrintOutput ws, "a", OutputRow, Ref
    PrintOutput ws, "b", OutputRow, Name
    PrintOutput ws, "c", OutputRow, Foreground
    PrintOutput ws, "d", OutputRow, Text
    PrintOutput ws, "e", OutputRow, Val_1
    PrintOutput ws, "f", OutputRow, Val_2
    PrintOutput ws, "g", OutputRow, Val_3
    
    OutputRow = OutputRow + 1
    
Next Count_Ref

For Count_Ref = 10 To 20
    Ref = Count_Ref
    Error_msg = "Doing calcs for " & Count_Ref
    'check if Ref is in data set AND has a y against it in the Input 2 sheet, if not return default values
    If IsError(Application.VLookup(Count_Ref, Input_Data, 1, False)) Or Application.VLookup(Count_Ref, Input2, 1, False) = "" Then
        'Default values
        Name = "blank 10-20"
        Foreground = "RGB(255,255,255)"
        Text = "RGB(255,0,0)"
        Val_1 = "10 mm"
        Val_2 = "5 mm"
        Val_3 = 1
    Else
        'Do Calcs for 10-20
        Name = Application.VLookup(Count_Ref, Input_Data, 2, False)
        Colour = Application.VLookup(Count_Ref, Input_Data, 3, False)
        If IsError(Application.VLookup(Colour, Colours, 1, False)) Then Colour = "unknown" Else Colour = Colour
        Foreground = Application.VLookup(Colour, Colours, 2, False)
        Text = Application.VLookup(Colour, Colours, 3, False)
        Val_1 = Application.VLookup(Count_Ref, Input_Data, 4, False) * 3 & " mm"
        Val_2 = Application.VLookup(Count_Ref, Input_Data, 5, False) + 10 & " mm"
        Val_3 = Application.VLookup(Count_Ref, Input2, 3, False)
        Ref = Count_Ref
    End If
    
    'Enter Values in output
    PrintOutput ws, "a", OutputRow, Ref
    PrintOutput ws, "b", OutputRow, Name
    PrintOutput ws, "c", OutputRow, Foreground
    PrintOutput ws, "d", OutputRow, Text
    PrintOutput ws, "e", OutputRow, Val_1
    PrintOutput ws, "f", OutputRow, Val_2
    PrintOutput ws, "g", OutputRow, Val_3
    
    OutputRow = OutputRow + 1
    
Next Count_Ref

For Count_Ref = 21 To 30
    Ref = Count_Ref
    Error_msg = "Doing calcs for " & Count_Ref
    'check if Ref is in data set AND has a y against it in the Input 2 sheet, if not return default values
    If IsError(Application.VLookup(Count_Ref, Input_Data, 1, False)) Or Application.VLookup(Count_Ref, Input2, 1, False) = "" Then
        'Default values
        Name = "blank 21-50"
        Foreground = "RGB(255,255,255)"
        Text = "RGB(255,0,0)"
        Val_1 = "10 mm"
        Val_2 = "5 mm"
        Val_3 = 1
    Else
        'Do Calcs for 21-30
        Name = Application.VLookup(Count_Ref, Input_Data, 2, False)
        Colour = Application.VLookup(Count_Ref, Input_Data, 3, False)
        If IsError(Application.VLookup(Colour, Colours, 1, False)) Then Colour = "unknown" Else Colour = Colour
        Foreground = Application.VLookup(Colour, Colours, 2, False)
        Text = Application.VLookup(Colour, Colours, 3, False)
        Val_1 = Application.VLookup(Count_Ref, Input_Data, 4, False) - 1 & " mm"
        Val_2 = Application.VLookup(Count_Ref, Input_Data, 5, False) / 2 & " mm"
        Val_3 = Application.VLookup(Count_Ref, Input2, 3, False)
    End If
    
    'Enter Values in output
    PrintOutput ws, "a", OutputRow, Ref
    PrintOutput ws, "b", OutputRow, Name
    PrintOutput ws, "c", OutputRow, Foreground
    PrintOutput ws, "d", OutputRow, Text
    PrintOutput ws, "e", OutputRow, Val_1
    PrintOutput ws, "f", OutputRow, Val_2
    PrintOutput ws, "g", OutputRow, Val_3
    
    OutputRow = OutputRow + 1
    
Next Count_Ref

    Application.ScreenUpdating = True


Exit Sub
ErrHandle:
    If Err.Number > 0 Then
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
    End If
    Worksheets("Calcs for standard settings").Range("E1").Value = "error"
    MsgBox "The update has failed due to:" & vbNewLine & Error_msg & vbNewLine & "(error " & Err.Number & " - " & Err.Description & ")" & vbNewLine & "Please check for errors in code or data set", vbOKOnly + vbCritical, "Test Programm"
End Sub

Option Private Module
Sub PrintOutput(ws As Worksheet, sCol As String, OutputRow As Integer, sValue As String)
   If Not (ws.Range(sCol & OutputRow).Value = sValue) Then ws.Range(sCol & OutputRow).Value = sValue
End Sub

 

[diddi]

what do you mean by the function names of the array

 

[miless2111s]

what do you mean by the function names of the array

It means that when I wrote that I should have drunk my coffee - I missed the

Option Base 1
Dim AllData(3000, 10)

Section of the code!
What does "option Base 1" mean?

 

[diddi]

by default VBA arrays start at row 0 and column 0, (thats why listboxes and comboboxes have an index of 0)
for your project having arrays like that is a bit inconvenient so Option Base 1, changes the arrays to start at row 1, col 1

AllData is declared at the top so it can be shared

swap coffee for wine and it will all fall into place

 

[miless2111s]

by default VBA arrays start at row 0 and column 0, (thats why listboxes and comboboxes have an index of 0)
for your project having arrays like that is a bit inconvenient so Option Base 1, changes the arrays to start at row 1, col 1

AllData is declared at the top so it can be shared

swap coffee for wine and it will all fall into place

Thanks for the explanation on the Base1. Good point on the wine
Did the slightly more complex model make sense? The double, add 10 etc calcs are purely for show, the actual calcs that are done are more complex but they do use values pulled form vlookup etc so they're relevant to the model.
Regards
Miles