CODEWITHSUNDEEP
vbaexcel
WWalker
WWalker

Reputation: 11

Excel VBA trouble looping through sheets and calling subroutine

My subroutine works fine when I run it on individual sheets, but I've had a lot of problems getting it to run on each individual sheet. The Subroutine is a simple query of an online CSV database, but it only executes 25 times on the first sheet. can't figure out for the life of me why this is.

I was able to do calculations through this same loop, but could not get it to run a subroutine on each sheet. 

Sub Datacollection()

  Dim ws As Worksheet
  For Each ws In Worksheets

     ws.Application.Run "Gethistory"

  Next ws
End Sub


Sub Gethistory()
Dim Target As Variant
Dim Name As Variant
'
Set Target = Range("B1")
Set Name = Range("B2")

    With ActiveSheet.QueryTables.Add(Connection:= _
    "Text;" & Target, _
    Destination:=Range("$A$3"))
    .Name = Name
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlOverwriteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 437
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = True
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = True
    .TextFileSpaceDelimiter = True
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With

End Sub

Upvotes: 1

Views: 114

Answers (1)

user4039065
user4039065

Reputation:

Gather the worksheet to be processed in your primary loop and pass that to the getHistory sub as a parameter.

Option Explicit

Sub dataCollection()
    Dim w As Long
    For w = 1 To Worksheets.Count
         getHistory Worksheets(w)
    Next w
End Sub


Sub getHistory(ws As Worksheet)
    Dim trgt As Range, nm As Range

    With ws
        Set trgt = .Range("B1")
        Set nm = .Range("B2")

        With .QueryTables.Add(Connection:= _
          "Text;" & trgt.Value, _
          Destination:=.Range("$A$3"))
            .Name = nm.Value
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlOverwriteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = True
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = True
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
    End With

End Sub

If you do this repeatedly, you will end up with a lot of connections that could interfere in the general workbook efficiency as well as future getHistory runs. You might want to delete the connections as you create them or only use a refresh method to maintain the data.

Upvotes: 2

Related Questions