Loop through excel rows and insert data from adjacent cells into word variables

[GenuineGin]

Hello,

I'm trying to streamline my code a bit but I'm getting stuck. This is what I'm trying to achieve:

If [droplist in word document] = [value in first column of row X of excel] then
[Variable 1 in word document] = [value in second column of row X of excel]
[Variable 2 in word document] = [value in third column of row X of excel] etc.

I've got it working as (with all the previous setup):

If Me.comboAuthor.Value = exWb.Sheets("Sheet1").Cells(2, 1) Then
.Variables("Name").Value = exWb.Sheets("Sheet1").Cells(2, 1)
.Variables("Qualifications").Value = exWb.Sheets("Sheet1").Cells(2, 2) etc.

But that means I have to repeat the If statement for each original cell value and if more rows get added to the excel spreadsheet these won't be included.

I want to be able to loop through it, if that makes sense.

As always any help is much appreciated!

[Dave]

I'm guessing the reason for lack of replies is that your question is not that clear. Something like this...

Dim cnt As Integer, Lastcol As Integer
With Sheets("Sheet1")
Lastcol = .Cells(2, .Columns.Count).End(xlToLeft).Column
End With
For cnt = 1 To Lastcol
If Me.comboAuthor.Value = exWb.Sheets("Sheet1").Cells(2, cnt) Then
.Variables("Name").Value = exWb.Sheets("Sheet1").Cells(2, cnt)
.Variables("Qualifications").Value = exWb.Sheets("Sheet1").Cells(2, cnt)
End If
Next cnt
HTH. Dave

[gmayor]

Why not simply read the worksheet into the combobox, you can then select the columns you need? E.G. the following will display the first column of your worksheet in the combobox and the output will be the first and second columns of the selected item.


Option Explicit
Private RS As Object
Private CN As Object
Private numrecs As Long, q As Long
Private strWidth As String

Sub Example()
Dim strName As String
Dim strQual As String
With UserForm1
xlFillList .comboAuthor, 1, "C:\Path\Worksheet.xlsx", "SheetName"
.Show
strName = .comboAuthor.Column(1)
strQual = .comboAuthor.Column(2)
End With
Unload UserForm1
'do something with the variables
MsgBox strName & vbCr & strQual
End Sub

Public Function xlFillList(ListOrComboBox As Object, _
iColumn As Long, _
strWorkbook As String, _
strWorksheetName As String)

'Graham Mayor - http://www.gmayor.com - Last updated - 27 Jan 2018

'A function to fill a list or combo box with data from an Excel worksheet or a named range in a worksheet
'ListOrComboBox is the name of the list or combo box
'iColumn is the number of the Excel column to display in the list or combo box (starting from 1)
'the other columns are hidden
'strWorkbook is the name of the Excel data file
'strWorkSheetName is the part of the data file to be used

strWorksheetName = strWorksheetName & "$]"

Set CN = CreateObject("ADODB.Connection")

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.CursorLocation = 3

RS.Open "SELECT * FROM [" & strWorksheetName, CN, 2, 1 'read the data from the worksheet

With RS
.MoveLast 'find the last record
numrecs = .RecordCount 'and note its number
.MoveFirst 'return to the start
End With
With ListOrComboBox 'load the records into the columns of the named list/combo box
.ColumnCount = RS.Fields.Count
.Column = RS.GetRows(numrecs)
strWidth = vbNullString
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
.ColumnWidths = strWidth
End With
lbl_Exit:
If RS.State = 1 Then RS.Close
Set RS = Nothing
If CN.State = 1 Then CN.Close
Set CN = Nothing
Exit Function
End Function

[GenuineGin]

Hi Graham,

That's a perfect solution. Thank you!

I've copied the code you provided but I can't seem to make it work. The combo box doesn't populate. If I populate with an array the rest of it works so I'm thinking I've done something wrong with the function, not the sub? Do I need to define the strings/longs somewhere?

[gmayor]

You must ensure that in the following command line the four variables are correctly reflecting the names of the combo box, the workbook and the worksheet and that you want to display column # (here shown as 1) of the worksheet

xlFillList .comboAuthor, 1, "C:\Path\Worksheet.xlsx", "SheetName"

If you are using a named range rather than the full sheet, then replace the line

strWorksheetName = strWorksheetName & "$]"

withstrWorksheetName = strWorksheetName & "]"


If there is no header row in the table, change HDR=YES to HDR=NO

[GenuineGin]

Thanks Graham. I'm confident I've got all those elements right but it's still not working. I tried changing the sub to Sub Userform_Initialise() or CommandButton1_Click. That's bringing up the following error:

Run time error '-2147217865 (80040e37)':

The Microsoft Access database engine could not find the object 'Sheet1'. Make sure the object exists and that you spell it's name correctly. If 'Sheet1' is not a local object, check your network connection or contact the server administrator.

I have checked that the workbook/sheet exist and are spelled correctly.

When I debug, it highlights the line: RS.Open "SELECT * FROM [" & strWorksheetName, CN, 2, 1

If I leave it as Sub Example() the userform loads but the combo box stays empty...

[gmayor]

What is the sheet name that you are trying to interrogate and what is the full path of the workbook containing that sheet?

21490

[GenuineGin]

R:\CURRENT PROJECTS\10. TEMPLATES\EcIA Template\Code Test 2.xlsx "Sheet1"

[gmayor]

Then you want


xlFillList .comboAuthor, 1, "R:\CURRENT PROJECTS\10. TEMPLATES\EcIA Template\Code Test 2.xlsx", "Sheet1"
and leave the line below unchanged

strWorksheetName = strWorksheetName & "$]"If that still doesn't work, can you post your document and test workbook to me (so I can see what you are doing) at support@gmayor.com and make sure you put your forum username in the message subject or it will be discarded.