UserForm using vlookup from referneced excel sheet

Hi,

I'm attempting to (probably butchering it..) create a bit of code as part of my userform. One of the first textboxes filled is the unique "project number".

I'm trying to add some code that when the user exits from this textbox, this value is used in a vlookup to see if the project number exists in an existing excel document.

IF true, I want to set the values of several other textboxes on the userform equal to other values in the excel document.

I hope that make sense? Basically --> If Project number exists in Range C2:C1500 on "ProjectRegister" excel sheet, then set textbox1 = ProjectRegister Value A etc

So far I have the following code which is not complete (it should check if the value exists in the range but no more). It also is currently coming back with Error 91 but I cannot solve that either. Any help would be greatly appreciated!!!!:

Code:

---

Private Sub TB3_Exit(ByVal Cancel As MSForms.ReturnBoolean)'Below for lookup in excel sheet


   
    Dim oXL As Excel.Application
    Dim oWB As Excel.Workbook
    Dim oSheet As Excel.Worksheet
    Dim oRng As Excel.Range
    Dim ExcelWasNotRunning As Boolean
    Dim WorkbookToWorkOn As String
   
   
'________________________________________


    'Specifiy File to Open
  WorkbookToWorkOn = "C:\Users\billy\Desktop\GEA.JOBBOARD.xlsm"
    'Check if excel is open or start new
   
        On Error Resume Next
        Set oXL = GetObject(, "Excel.Application")
        If Err Then
            ExcelWasNotRunning = True
            Set oXL = New Excel.Application
        End If
       
        On Error GoTo Err_Handler
       
'If you want to see the excel put "oXL.Visible = true" but it slows sh*t down


'open book


                Set oWB = oXL.Workbooks.Open(FileName:=WorkbookToWorkOn)
   
                Set wsht = ActiveWorkbook
                Set wksheet = wsht.Worksheets("ProjectRegister")
   
                If oXL.WorksheetFunction.VLookup(Me.TB3, oSheet("ProjectRegister").Range("C2:C1500"), 1, False) = True Then
               
'THIS IS WHERE I GOT TO BEFORE GETTING STUMPED

MsgBox oXL.WorksheetFunction.VLookup(Me.TB3, oSheet.Range("C2:C1500"), 1, False)
   
    End If
   
If ExcelWasNotRunning Then
oXL.Quit
End If


Set oRng = Nothing
Set oSheet = Nothing
Set oWB = Nothing
Set oXL = Nothing


Exit Sub


Err_Handler:
  MsgBox WorkbookToWorkOn & " caused a problem. " & Err.Description, vbCritical, _
          "Error: " & Err.Number
  If ExcelWasNotRunning Then
      oXL.Quit
  End If
End Sub

---

I wouldn't do it like that. It would be infinitely faster to read the sheet into an array then interrogate the array for the value that you want. e.g. in the following example the code looks for the value entered into TB3 in Column C then puts the corresponding value from Column A in TB1. You can pick the value from any column by altering the number i.e. arr(4, i) 'Column E

Code:

---

Option ExplicitConst strWorkbook As String = "C:\Users\billy\Desktop\GEA.JOBBOARD.xlsm"
Const strSheet as string = "ProjectRegister"


Private Sub TB3_Exit(ByVal Cancel As MSForms.ReturnBoolean) 
Dim arr() As Variant
Dim i As Long
Dim sRequired As String
Dim sFind As String
    arr = xlFillArray(strWorkbook, strSheet)
    For i = 0 To UBound(arr, 2)
        sFind = arr(2, i) 'Column C
        sRequired = arr(0, i) 'Column A
        If sFind = TB3.Text Then
            TB1.Text = sRequired
            Exit For
        Else
            TB1.Text = "Not Found"
        End If
    Next i
lbl_Exit:
    Exit Sub
End Sub




Private Function xlFillArray(strWorkbook As String, _
                            strRange As String) As Variant
'Graham Mayor - http://www.gmayor.com - 24/09/2016
Dim RS As Object
Dim CN As Object
Dim iRows As Long


strRange = strRange & "$]"    'Use this to work with a named worksheet
    'strRange = strRange & "]" 'Use this to work with a named range
    Set CN = CreateObject("ADODB.Connection")


    'Set HDR=NO for no header row
    CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
                              "Data Source=" & strWorkbook & ";" & _
                              "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"


    Set RS = CreateObject("ADODB.Recordset")
    RS.Open "SELECT * FROM [" & strRange, CN, 2, 1


    With RS
        .MoveLast
        iRows = .RecordCount
        .MoveFirst
    End With
    xlFillArray = RS.getrows(iRows)
    If RS.State = 1 Then RS.Close
    Set RS = Nothing
    If CN.State = 1 Then CN.Close
    Set CN = Nothing
lbl_Exit:
    Exit Function
End Function

---

Thank you Graham. Solved my problem in one quick swoop!

If you have a second - Am i right in assuming that using an array is quicker because it requests the data from excel once and stores it locally within vba? instead of looking at excel each time?

Thank you again.

Further to the above Graham,

I've added several lines to set sRequired1,2,3 etc..

When the column value in ( sRequired = arr(0, i) 'Column A ) this is set to more than 9 (ie. 10 11 12 etc) it says the value is set to null. I've checked to ensure the value is nut set to null, is of normal text, saved file closed file and everything else I can think of? Guessing it's something simple?

Billy,

You may need to provide more details. I've added columns past 9 in a test worksheet and Graham's code is working fine to return the content.

Hi Greg,

See image here of error:
Attachment 24685


Here is the full code:


Does this help ?

Code:

---








Private Sub TB3_Exit(ByVal Cancel As MSForms.ReturnBoolean)




Const strWorkbook As String = "C:\Users\billy\Desktop\GEA.JOBBOARD.xlsm"
Const strSheet As String = "ProjectRegister"
Dim arr() As Variant
Dim i As Long
Dim sRequired As String  'Column E Project Description
Dim SRequired2 As String 'Column F Address
Dim SRequired3 As String 'Column G Suburb
Dim SRequired4 As String 'Column J Client on Report
Dim SRequired5 As String 'Column K Client on Report


Dim sFind As String
    arr = xlFillArray(strWorkbook, strSheet)
    For i = 0 To UBound(arr, 2)
        sFind = arr(2, i) 'Column C
        sRequired = arr(4, i) 'Column E
        SRequired2 = arr(5, i) 'Column F
        SRequired3 = arr(6, i) 'Column G
        SRequired4 = arr(9, i) 'Column J
        SRequired5 = arr(10, i) 'Column K This line returns the error (it says that arr(10,i) = null) the value in Ki is an email address. I've changed it to just a number to test it as well?
               
        If sFind = TB3.Text Then
            TB1.Text = SRequired4
            TextBox5.Text = SRequired2 & ", " & SRequired3
            TextBox4.Text = sRequired
            TextBox1.Text = SRequired5
            Exit For
        Else
            TB1.Text = "Not Found"
        End If
    Next i
lbl_Exit:
    Exit Sub
End Sub

---

Hey Gents,

Further to the above, I've tweaked a couple things and now I am not getting the "null error" but the value of the array is equal to "" .. I can't figure it out but then again I'm only just following the code that's been generously gifted (thanks again)..

I *THINK* the code is somehow pulling the first value in Column K (ie. "1") but then the right hand side of the array formula is not? I'm not too sure what's happening..

See Photos 1 to 3 showing the values and excel data and code below..

Figure 1:
Attachment 24686

Figure 2:
Attachment 24687

Figure 3:

Attachment 24688

Code:

---






Private Sub TB3_Exit(ByVal Cancel As MSForms.ReturnBoolean)


Const strWorkbook As String = "C:\Users\billy\Desktop\GEA.JOBBOARD.xlsm"
Const strSheet As String = "ProjectRegister"
Dim arr() As Variant
Dim i As Long
Dim sRequired As String  'Column E Project Description
Dim SRequired2 As String 'Column F Address
Dim SRequired3 As String 'Column G Suburb
Dim SRequired4 As String 'Column J Client on Report
Dim SRequired5 As String 'Column K Email Address




Dim sFind As String
    arr = xlFillArray(strWorkbook, strSheet)
    For i = 0 To UBound(arr, 2)
            sFind = arr(2, i) 'Column C
        sRequired = arr(4, i) 'Column E
        SRequired2 = arr(5, i) 'Column F
        SRequired3 = arr(6, i) 'Column G
        SRequired4 = arr(9, i) 'Column J
        SRequired5 = arr(10, i) 'Column K
       
               
        If sFind = TB3.Text Then
       
           
            TB1.Text = SRequired4
            TextBox5.Text = SRequired2 & ", " & SRequired3
            TextBox4.Text = sRequired
            TB1.Text = SRequired4
            TextBox1.Text = SRequired5


            Exit For
        Else
            TB1.Text = "Not Found"
        End If


       
    Next i
lbl_Exit:
    Exit Sub
End Sub

---

The Else part of the code is also not working if an invalid project number is input at the start - it just comes up with the same error at the sFind line..

I must be doing something wrong?

Sorry for the thousand questions.. I'm just completely stumped

The array function reads the data directly from the sheet without opening Excel.
Without the actual worksheet (your illustration is too small to read) it is difficult to ascertain what is wrong, but the implication is that you have empty values in the sheet which messes up the array.
You could use https://www.gmayor.com/ColumnValues.htm to check your data.
If it helps you can change a couple of values in the function (where indicated) and use a named range instead of the sheet.

Hi Graham,

I downloaded the add in and looked at the excel sheet.

The array works when the data is purely integer? based (ie. "4" or "665"etc) but as soon as the input is text based the error occurs.

I've attached the excel sheet for perusal?

Thanks again.

Given sight of the sheet, I would do it differently. See http://www.gmayor.com/Userform_ComboBox.html and the attached which assumes that your workbook is stored at "C:\Users\billy\Desktop\GEA.JOBBOARD.xlsm"

Thanks for your quick reply.

I had leaned towards the values populating existing boxes in an userform that then populates document variables (something I learned from your website - thank you again).

I've just had a go with your file but am not getting the same error; however, the value for the email is blank.

It returns as blank in your example file; however, if I change the value from "lettuce" to a number (ie. "5" ) it works. See image below

Attachment 24694

Is this maybe a glitch at my end? Does it work at your end?

thanks,

If you comment out the lines shown below, you can see what is in each column in the combobox. Format the column as Text rather than General and try it again.

Code:

---

For q = 1 To .ColumnCount        '    If q = iColumn Then
        '        If strWidth = vbNullString Then
                    strWidth = .Width - 4 & " pt"
        '        Else
        '            strWidth = strWidth & .Width - 4 & " pt"
        '        End If
        '    Else
        '        strWidth = strWidth & "0 pt"
        '    End If
            If q < .ColumnCount Then
                strWidth = strWidth & ";"
            End If
        Next q

---

Billy,

I looked at your database. It seems the reason column K was returning "Null" instead of "Lettuce" was because of the data format "General" you had applied. Changing that to "Text" worked or leaving it as is and changing the connection string to:

Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1""

also worked.

Thank you both. I do really appreciate the help and patience.

I used the solution with adding IMEX=1 as that allows for more error at the user end.

Thanks both again.