UPDATED 3/30
So I adjusted the code and it runs error free now but the issue is that it does not pull the correct data. X basically starts with cell(X,1) and goes on from there. How do I link X to the selected listbox options in the array?
OLD Message: I have a userform that allows for multi-select of Countries and also Questions about that specific country. These are stored in arrCountries & arrQuestion respectively. This then feeds to my main sub which calls for a Web Query Import from the CIA World Factbook site. I keep however getting a mismatch error that I cannot seem to sort out how to get around:
If I had to guess it is because when I am filling the array from the listbox's it is just adding a string and not the cell reference that the string is located at (or I am completely wrong).
My worksheet has only 1 sheet when started called Countries and the Column A is the URL and Column B is the Country name. I have Defined Public arrCountry(), Public arrQuestion(), and Public X as variant.
Code here:
Userform Code when click okay:
'Handles when the user clicks okay
Private Sub cbOkay_Click()
'Me.Hide
'Capture ticker selection(s) from list box.
Dim cI As Long
Dim cX As Long
Dim qI As Long
Dim qX As Long
'Stores the Countries selected into an array
If lbCountries.ListIndex <> -1 Then
For cI = 0 To lbCountries.ListCount - 1
If lbCountries.Selected(cI) Then
ReDim Preserve arrCountry(cX)
arrCountry(cX) = lbCountries.List(cI)
cX = cX + 1
End If
Next cI
End If
If cX = 0 Then MsgBox "Please select at least one country to analyse."
'MsgBox Join(arrCountry, vbCrLf)
'Stores the Questions selected into an array
If lbQuestions.ListIndex <> -1 Then
For qI = 0 To lbQuestions.ListCount - 1
If lbQuestions.Selected(qI) Then
ReDim Preserve arrQuestion(qX)
arrQuestion(qX) = lbQuestions.List(qI)
qX = qX + 1
End If
Next qI
End If
If qX = 0 Then MsgBox "Please select at least one question to analyse."
'MsgBox Join(arrQuestion, vbCrLf)
'Unload the form
Unload Me
cancel = False
End Sub
The message boxes return the correctly selected Listbox items so I know they are being stored correctly.
The WebQuery Code I am getting the error on:
UPDATED CODE:
So I added a loop counter:
Sub webQueryimport(arrCountry())
Dim mystr As String
Dim X As Integer
Dim selected As Variant
For Each selected In arrCountry
X = X + 1
Worksheets("Countries").Select
Worksheets("Countries").Activate
mystr = Cells(X, 1)
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = selected
With ActiveSheet.QueryTables.Add(Connection:=mystr, Destination:=Range("$A$1"))
.WebSelectionType = xlEntirePage 'this tells VBA what to select and import
.WebFormatting = xlWebFormattingNone 'this turns off web formatting, otherwise text is various sizes
.Refresh BackgroundQuery:=False 'if commented out, doesn't add any data
End With
Next selected
End Sub
Again, now that loop works and will import but it always starts with the A1 no matter what is selected in the listbox and in arrCountries
Any thoughts/assistance would be great!
Got it:
Sub webQueryimport(arrCountry())
Dim mystr As String
Dim X As Integer
Dim rng As Range
Dim selected As Variant
Set rng = Range("B1")
For Each selected In arrCountry()
For X = 1 To 5 'rng.Offset(0, 0).End(xlDown).Rows.count
Worksheets("Countries").Select
Worksheets("Countries").Activate
If Cells(X, 2).Value = selected Then
mystr = Cells(X, 1).Value
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = selected
With ActiveSheet.QueryTables.Add(Connection:=mystr, Destination:=Range("$A$1"))
.WebSelectionType = xlEntirePage 'this tells VBA what to select and import
.WebFormatting = xlWebFormattingNone 'this turns off web formatting, otherwise text is various sizes
.Refresh BackgroundQuery:=False 'if commented out, doesn't add any data
End With
End If
Next X
Next selected
End Sub
I needed to add in a counter and the IF statement to check to see if the value in the array matched the cell value in the sheet and then return the appropriate cell for the import.