vbaexcelexcel-web-query

VBA: Array cell reference Mismatch error


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:

Mismatch Error in Yellow

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!


Solution

  • 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.