UserForm using vlookup from referneced excel sheet

[BillyB]

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

[gmayor]

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

[BillyB]

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.

[BillyB]

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?

[gmaxey]

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.

[BillyB]

Hi Greg,

See image here of error:
24685


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

[BillyB]

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

Figure 2:
24687

Figure 3:

24688








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

[gmayor]

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.

[BillyB]

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.

[gmayor]

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"

[BillyB]

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

24694

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

thanks,

[gmayor]

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

[gmaxey]

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.

[BillyB]

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.