How to loop through same column on specific sheets in excel vba?

Question

Hi StackOverflow community:

I'd like to loop through the same column on three specific sheets in my workbook. I understand there needs to be something along the lines of code similar to what's been posted here and here, but I can't seem to get them to work and instead receive the error '1004', "Application-defined or object-defined error".

Additional notes: I entered "For each ws in this Workbook.sheets" after the declarations, and "Next" at the very end before "End Sub". I also tried the processing code after "r=1" in the code below and received the same 1004 error. I tried this with "Next" after the loop code and it still only looped through the first sheet.

This is the code:

Sub MakeWordList()
Dim InputSheet As Worksheet
Dim WordListSheet As Worksheet
Dim PuncChars As Variant, x As Variant
Dim i As Long, r As Long
Dim txt As String
Dim wordCnt As Long
Dim AllWords As Range
Dim PC As PivotCache
Dim PT As PivotTable

    Application.ScreenUpdating = False
    Set InputSheet = ActiveSheet
    Set WordListSheet = Worksheets.Add(after:=Worksheets(Sheets.Count))
    WordListSheet.Range("A1") = "All Words"
    WordListSheet.Range("A1").Font.Bold = True
    InputSheet.Activate
    wordCnt = 2
    PuncChars = Array(".", ",", ";", ":", "'", "!", "#", _
        "$", "%", "&", "(", ")", " - ", "_", "--", "+", _
        "=", "~", "/", "\", "{", "}", "[", "]", """", "?", "*")
    r = 1


'   Loop until blank cell is encountered
    Do While Cells(r, 7) <> ""
'       covert to UPPERCASE
        txt = UCase(Cells(r, 7))
'       Remove punctuation
        For i = 0 To UBound(PuncChars)
            txt = Replace(txt, PuncChars(i), "")
        Next i
'       Remove excess spaces
        txt = WorksheetFunction.Trim(txt)
'       Extract the words
        x = Split(txt)
        For i = 0 To UBound(x)
            WordListSheet.Cells(wordCnt, 1) = x(i)
            wordCnt = wordCnt + 1
        Next i
    r = r + 1
    Loop

'   Create pivot table
    WordListSheet.Activate
    Set AllWords = Range("A1").CurrentRegion
    Set PC = ActiveWorkbook.PivotCaches.Add _
        (SourceType:=xlDatabase, _
        SourceData:=AllWords)
    Set PT = PC.CreatePivotTable _
        (TableDestination:=Range("C1"), _
        TableName:="PivotTable1")
    With PT
        .AddDataField .PivotFields("All Words")
        .PivotFields("All Words").Orientation = xlRowField
    End With

End Sub

Is there any way I can loop through my first three sheets or identify the sheets I want to loop through? Specifically, I'd like to loop through column G of each of the first three sheets.

Have you got some data to use to evaluate your functions ? I.e. I can review your function but cannot determine how it interacts with your data ? On a different note, you use For i=0 to ubound(array) which is good, nicer would For i=Lbound(array) to ubound(array) That would prevent out of range errors :-) Provide some column data that you use and it will be easier to accommodate ? — mtholen, Oct 03 '15 at 00:36

score 0 · Answer 1 · answered Oct 03 '15 at 15:27

I'd do something like this, but I haven't had chance to test this out so it may need tidying up.

Dim lSheets(2)

lSheets(0) = "Sheet1"
lSheets(1) = "Sheet2"
lSheets(2) = "Sheet3"

    Application.ScreenUpdating = False

    Set WordListSheet = Worksheets.Add(after:=Worksheets(Sheets.Count))
    WordListSheet.Range("A1") = "All Words"
    WordListSheet.Range("A1").Font.Bold = True

For k = LBound(lSheets) To UBound(lSheets)
    Set InputSheet = Sheets(lSheets(k))

    InputSheet.Activate

'REST OF CODE'

    r = r + 1
    Loop

Next k


'   Create pivot table
    WordListSheet.Activate

'REST OF CODE'

How to loop through same column on specific sheets in excel vba?

1 Answers1