Lookup in closed workbook
-
- Administrator
- Posts: 78545
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Lookup in closed workbook
You might put the number of items in a public variable, just like colNames.
Set the value of this variable in cmdOK_Click, and use it in FinalCode.
Set the value of this variable in cmdOK_Click, and use it in FinalCode.
Best wishes,
Hans
Hans
-
- PlatinumLounger
- Posts: 4931
- Joined: 31 Aug 2016, 09:02
Re: Lookup in closed workbook
To avoid confusion here's the code in the userform I am using now
And in the standard module
The code seems to be working fine if I select more than a column but if I select only one column it doesn't work. Also I need to put the headers according to the selected headers ..
Code: Select all
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Me.ListBox2.AddItem Me.ListBox1.List(ListBox1.ListIndex)
Me.ListBox1.RemoveItem Me.ListBox1.ListIndex
End Sub
Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Me.ListBox1.AddItem ListBox2.List(ListBox2.ListIndex)
Me.ListBox2.RemoveItem Me.ListBox2.ListIndex
End Sub
Private Sub cmdOK_Click()
Dim i As Long
Set aCols = Nothing
With Me.ListBox2
ReDim aCols(0 To .ListCount - 1)
For i = 0 To .ListCount - 1
aCols(i) = "[" & ListBox2.List(i, 0) & "]"
Next i
End With
Debug.Print UBound(aCols)
If UBound(aCols) = -1 Then MsgBox "You Have To Select At Least One Column", vbExclamation
Unload Me
End Sub
Code: Select all
Public aCols
Sub FinalCode()
Dim arIn1, arIn2, arOut, s, ws As Worksheet, cn As Object, rs As Object, sq As String, pt As String, colNames As String, iCol As Integer, m As Long, r As Long, c As Long
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select The Data File"
.AllowMultiSelect = False
.InitialFileName = ThisWorkbook.Path & "\"
If .Show <> -1 Then Exit Sub
pt = .SelectedItems(1)
End With
Set cn = CreateObject("ADODB.Connection")
cn.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & pt & "';" & "Extended Properties=""Excel 12.0;HDR=YES;IMEX=1;"";"
Set rs = CreateObject("ADODB.Recordset")
sq = "SELECT * FROM [Sheet1$]"
rs.Open Source:=sq, ActiveConnection:=cn, Options:=1
rs.Close
For iCol = 0 To rs.Fields.Count - 1
With UserForm1.ListBox1
.AddItem rs.Fields(iCol).Name
End With
Next iCol
UserForm1.Show
If UBound(aCols) > 0 Then
sq = "SELECT [Reference] " & "FROM [Sheet1$] ORDER BY [Reference]"
rs.Open Source:=sq, ActiveConnection:=cn, Options:=1
arIn1 = rs.GetRows
rs.Close
colNames = Join(aCols, ", ")
sq = "SELECT " & colNames & " FROM [Sheet1$] ORDER BY [Reference]"
rs.Open Source:=sq, ActiveConnection:=cn, Options:=1
arIn2 = rs.GetRows
rs.Close
cn.Close
Set ws = ThisWorkbook.Worksheets(1)
m = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
arOut = ws.Range("B1").Resize(m, UBound(aCols) + 2).Value
For r = 2 To m
s = Application.Match(arOut(r, 1), arIn1, 0)
If Not IsError(s) Then
For c = 1 To UBound(aCols) + 1
arOut(r, c + 1) = arIn2(c - 1, s - 1)
Next c
End If
Next r
Application.ScreenUpdating = False
ws.Range("B1").Resize(m, UBound(aCols) + 2).Value = arOut
End If
End Sub
-
- Administrator
- Posts: 78545
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
-
- PlatinumLounger
- Posts: 4931
- Joined: 31 Aug 2016, 09:02
Re: Lookup in closed workbook
Thanks a lot. Take your time.
-
- Administrator
- Posts: 78545
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Lookup in closed workbook
Could you attach the workbook with the current version of the userform and code?
Best wishes,
Hans
Hans
-
- PlatinumLounger
- Posts: 4931
- Joined: 31 Aug 2016, 09:02
Re: Lookup in closed workbook
OK my tutor
You do not have the required permissions to view the files attached to this post.
-
- Administrator
- Posts: 78545
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Lookup in closed workbook
Try this version:
Code: Select all
Sub FinalCode()
Dim arIn1, arIn2, arOut, s, ws As Worksheet, cn As Object, rs As Object, sq As String, pt As String, colNames As String, iCol As Integer, m As Long, r As Long, c As Long
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select The Data File"
.AllowMultiSelect = False
.InitialFileName = ThisWorkbook.Path & "\"
If .Show <> -1 Then Exit Sub
pt = .SelectedItems(1)
End With
Set cn = CreateObject("ADODB.Connection")
cn.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & pt & "';" & "Extended Properties=""Excel 12.0;HDR=YES;IMEX=1;"";"
Set rs = CreateObject("ADODB.Recordset")
sq = "SELECT * FROM [Sheet1$]"
rs.Open Source:=sq, ActiveConnection:=cn, Options:=1
rs.Close
For iCol = 0 To rs.Fields.Count - 1
With UserForm1.ListBox1
.AddItem rs.Fields(iCol).Name
End With
Next iCol
UserForm1.Show
If UBound(aCols) >= 0 Then
sq = "SELECT [Reference] " & "FROM [Sheet1$] ORDER BY [Reference]"
rs.Open Source:=sq, ActiveConnection:=cn, Options:=1
arIn1 = rs.GetRows
rs.Close
colNames = Join(aCols, ", ")
sq = "SELECT " & colNames & " FROM [Sheet1$] ORDER BY [Reference]"
rs.Open Source:=sq, ActiveConnection:=cn, Options:=1
Set ws = ThisWorkbook.Worksheets(1)
ws.Range("C:IV").Clear
For iCol = 0 To rs.Fields.Count - 1
ws.Cells(1, iCol + 3).Value = rs.Fields(iCol).Name
Debug.Print rs.Fields(iCol).Name, rs.Fields(iCol).Type
Select Case rs.Fields(iCol).Type
Case 2, 3 ' asSmallInt, adInteger
ws.Cells(1, iCol + 3).EntireColumn.NumberFormat = "0"
Case 4, 5 ' adSingle, adDouble
ws.Cells(1, iCol + 3).EntireColumn.NumberFormat = "#,#00.00"
Case 7 ' adDate
ws.Cells(1, iCol + 3).EntireColumn.NumberFormat = "m/d/yyyy"
Case Else
ws.Cells(1, iCol + 3).EntireColumn.NumberFormat = "@"
End Select
Next iCol
arIn2 = rs.GetRows
rs.Close
cn.Close
m = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
arOut = ws.Range("B1").Resize(m, UBound(aCols) + 2).Value
For r = 2 To m
s = Application.Match(arOut(r, 1), arIn1, 0)
If Not IsError(s) Then
For c = 1 To UBound(aCols) + 1
arOut(r, c + 1) = arIn2(c - 1, s - 1)
Next c
End If
Next r
Application.ScreenUpdating = False
With ws.Range("B1").Resize(m, UBound(aCols) + 2)
.Value = arOut
.EntireColumn.AutoFit
End With
End If
End Sub
Best wishes,
Hans
Hans
-
- PlatinumLounger
- Posts: 4931
- Joined: 31 Aug 2016, 09:02
Re: Lookup in closed workbook
Amazing my tutor. Thank you very much for great help in this topic.
-
- PlatinumLounger
- Posts: 4931
- Joined: 31 Aug 2016, 09:02
Re: Lookup in closed workbook
Just one last point my tutor.
When I tested the code and didn't select any item from listbox1 then listbox2 is empty and at this case when I clicked OK I encountered an error at this line
ReDim aCols(0 To .ListCount - 1)
How to avoid such error and exit the whole sub ..?
When I tested the code and didn't select any item from listbox1 then listbox2 is empty and at this case when I clicked OK I encountered an error at this line
ReDim aCols(0 To .ListCount - 1)
How to avoid such error and exit the whole sub ..?
-
- Administrator
- Posts: 78545
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Lookup in closed workbook
Add a check on ListBox2.ListCount. If it is 0, exit cmdOK_Click.
In FinalCode, you can test whether aCols is empty.
In FinalCode, you can test whether aCols is empty.
Best wishes,
Hans
Hans
-
- PlatinumLounger
- Posts: 4931
- Joined: 31 Aug 2016, 09:02
Re: Lookup in closed workbook
I tried this .. It works for the part of the userform but as for aCols is empty in the standard module didn't work.
-
- Administrator
- Posts: 78545
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Lookup in closed workbook
Since you set aCols to Nothing in cmdOK_Click, you should be able to use
in FinalCode.
Code: Select all
If aCols Is Nothing Then Exit Sub
Best wishes,
Hans
Hans
-
- PlatinumLounger
- Posts: 4931
- Joined: 31 Aug 2016, 09:02
Re: Lookup in closed workbook
But in this case if I used
If aCols Is Nothing Then Exit Sub
then when selecting columns the error araised ..Object required
If aCols Is Nothing Then Exit Sub
then when selecting columns the error araised ..Object required
-
- PlatinumLounger
- Posts: 4931
- Joined: 31 Aug 2016, 09:02
Re: Lookup in closed workbook
Instead of using
I used this line that solved the problem
Thank you very much for great helkp in this topic and for your patience.
Code: Select all
Set aCols = Nothing
Code: Select all
aCols = Array()