Getting values from other sheets inside vba module

[Green Squirrel]

I have a vba script to get tables form a website and put them in Excel.

Public Sub ImportTBL()

    Dim destCell As Range
    Dim QT As QueryTable
    Dim qtResultRange As Range
    Dim URL As String
    Dim sourceSheet As Worksheet
    Dim TBL As String
    
    Set sourceSheet = Sheet2
    
    TBL = ThisWorkbook.Sheets(1).Range("A1")
    URL = ThisWorkbook.Sheets(1).Range("A2")
    
    With sourceSheet
        Set destCell = .Range(ThisWorkbook.Sheets(1).Range("A3"))
        On Error Resume Next
        .ListObjects(TBL).Delete
        On Error GoTo 0
    End With
    
    Set QT = destCell.Worksheet.QueryTables.Add(Connection:="URL;" & URL, Destination:=destCell)
    
    With QT
        .RefreshStyle = xlOverwriteCells
        .WebFormatting = xlNone
        .WebSelectionType = xlSpecifiedTables
        .WebTables = ThisWorkbook.Sheets(1).Range("A4")
        .BackgroundQuery = False
        .Refresh
        Set qtResultRange = .ResultRange
        .Delete
    End With
    
    With destCell
        .Worksheet.ListObjects.Add(xlSrcRange, .CurrentRegion, , xlYes).Name = TBL
        sourceSheet.ListObjects(TBL).ShowAutoFilterDropDown = False
    End With

End Sub

As you can see I get the values for TBL, URL, destCell and .WebTables from a different sheet. So these are variable. Reason for me doing this is that I want to use this script multiple times.
The final version will have about 16 colums with each having 4 rows.

So Instead for making 16 odd subs I want make a script that runs the data and use this data in my script above.
But I haven't got a clue where to start.

Tips and hints most welcome.

 

[R2ah1ze1l]

I recommend 'For Each'
At the end, offset from column 'A' to column 'B' ....so on and so forth until empty.
It should start right before: TBL = ThisWorkbook.Sheets(1).Range("A1") instead of "A1" change it to "cells.(1,i)"
You can use the i as a counter. You will make the same amendment everywhere you have called out a dedicated column range.

HTH

 

[Green Squirrel]

Thank you. Do you by have any chance an example? Not very familiar with vba. Only reason Im doing it is because Excel for Mac doesn’t have Power Query.

I know what each command does but putting it together is something else.

thank you in advance

 

[R2ah1ze1l]

Crude manor:

i=1
worksheet.range(cells(1,1),cells(1,i)).Activate
While Not ActiveCell = ""
                                        **your code**
    TBL = ThisWorkbook.Sheets(1).Range(cells(1,i))
    URL = ThisWorkbook.Sheets(1).Range(cells(2,i))
    
    With sourceSheet
        Set destCell = .Range(ThisWorkbook.Sheets(1).Range(cells(3,i)))
        On Error Resume Next
        .ListObjects(TBL).Delete
        On Error GoTo 0
    End With
    
    Set QT = destCell.Worksheet.QueryTables.Add(Connection:="URL;" & URL, Destination:=destCell)
    
    With QT
        .RefreshStyle = xlOverwriteCells
        .WebFormatting = xlNone
        .WebSelectionType = xlSpecifiedTables
        .WebTables = ThisWorkbook.Sheets(1).Range(cells(4,i))
        .BackgroundQuery = False
        .Refresh
        Set qtResultRange = .ResultRange
        .Delete
    End With
    
    With destCell
        .Worksheet.ListObjects.Add(xlSrcRange, .CurrentRegion, , xlYes).Name = TBL
        sourceSheet.ListObjects(TBL).ShowAutoFilterDropDown = False
    End With
i=i+1
Wend

All I've done is replace the dedicated selections with the chance for the column to be updated by the 'i' counter.

Should you have information in column C but not in B this style will not execute after completing A.
GL

 

[Green Squirrel]

Crude manor:

i=1
worksheet.range(cells(1,1),cells(1,i)).Activate
While Not ActiveCell = ""
                                        **your code**
    TBL = ThisWorkbook.Sheets(1).Range(cells(1,i))
    URL = ThisWorkbook.Sheets(1).Range(cells(2,i))
   
    With sourceSheet
        Set destCell = .Range(ThisWorkbook.Sheets(1).Range(cells(3,i)))
        On Error Resume Next
        .ListObjects(TBL).Delete
        On Error GoTo 0
    End With
   
    Set QT = destCell.Worksheet.QueryTables.Add(Connection:="URL;" & URL, Destination:=destCell)
   
    With QT
        .RefreshStyle = xlOverwriteCells
        .WebFormatting = xlNone
        .WebSelectionType = xlSpecifiedTables
        .WebTables = ThisWorkbook.Sheets(1).Range(cells(4,i))
        .BackgroundQuery = False
        .Refresh
        Set qtResultRange = .ResultRange
        .Delete
    End With
   
    With destCell
        .Worksheet.ListObjects.Add(xlSrcRange, .CurrentRegion, , xlYes).Name = TBL
        sourceSheet.ListObjects(TBL).ShowAutoFilterDropDown = False
    End With
i=i+1
Wend

All I've done is replace the dedicated selections with the chance for the column to be updated by the 'i' counter.

Should you have information in column C but not in B this style will not execute after completing A.
GL

Thank you. What do you mean with ***Your code***?

 

[R2ah1ze1l]

Thank you. What do you mean with ***Your code***?

That was an error on my part, I meant to take that back out before posting