Consulting

Results 1 to 14 of 14

Thread: UserForm using vlookup from referneced excel sheet

  1. #1
    VBAX Regular
    Joined
    Jul 2019
    Posts
    10
    Location

    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!!!!:

    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

  2. #2
    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

    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Regular
    Joined
    Jul 2019
    Posts
    10
    Location
    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.

  4. #4
    VBAX Regular
    Joined
    Jul 2019
    Posts
    10
    Location
    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?



  5. #5
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,099
    Location
    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.
    Greg

    Visit my website: http://gregmaxey.com

  6. #6
    VBAX Regular
    Joined
    Jul 2019
    Posts
    10
    Location
    Hi Greg,

    See image here of error:
    Capture.jpg


    Here is the full code:


    Does this help ?

    
    
    
    
    
    
    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

  7. #7
    VBAX Regular
    Joined
    Jul 2019
    Posts
    10
    Location
    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:
    Image1.jpg

    Figure 2:
    Image2.jpg

    Figure 3:

    Image3.jpg

    
    
    
    
    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

  8. #8
    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.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  9. #9
    VBAX Regular
    Joined
    Jul 2019
    Posts
    10
    Location
    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.
    Attached Files Attached Files

  10. #10
    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"
    Attached Files Attached Files
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  11. #11
    VBAX Regular
    Joined
    Jul 2019
    Posts
    10
    Location
    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

    Capture.jpg

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

    thanks,

  12. #12
    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.

    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  13. #13
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,099
    Location
    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.
    Greg

    Visit my website: http://gregmaxey.com

  14. #14
    VBAX Regular
    Joined
    Jul 2019
    Posts
    10
    Location
    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •