Excel VBA: For loop to scan a set range of worksheets

Question

I have a workbook with 26 sheets in it. I want to scan the D column in only a specific 17 of those sheets, starting at cell "D15". These 15 sheets do go in incremenetal order, however, i.e. I want to scan between the 4th and 20th sheets.

The following code is what I have so far, the user "Head of Catering" started me off with it in a previous question: Copy Paste macro is inducing 'grouped'-worksheet functionality?

Sub DSR_Autofill()

Variable Declarations:

Dim x_count As Long     'keeps track of how many "x"s you have
Dim i As Long           'for loop index
Dim n As Long           'while loop index

' Variable Initializations:

x_count = 0             'start x count at zero

' Clear Previous Data:

Sheets(2).Range("A25:A29").ClearContents        'Clears Summary Pages before scanning through
Sheets(3).Range("A18:A200").ClearContents

' Main Data Transfer Code:

For i = 5 To i = 20     'Starts at "Process Controls" and ends on "Product Stewardship"

    Sheets(i).Select    'Select current indexed worksheet and...
    Range("D15").Select '...the first item cell in the "Yes" Column

    n = 0               'initialize n to start at top item row every time

        Do While ActiveCell.Offset(n, -3) <> Empty      'Scan down "YES" column until Item Column (just A Column)...
                                                        '...has no characters in it (this includes space (" "))
            Call Module2.algorithm(x_count, n)  'See subroutine code
            Sheets(i).Select                    'Return to frame of reference
            Range("D15").Select

        Loop            'syntax for continuation of while loop

    i = i + 1

Next i                  'syntax for continuation of for loop


If (x_count > 5) Then               'Bring user back to the Summary Page where...
                                    '...the last Item was logged
    Sheets("SUMMARY P.2").Select

Else

    Sheets("SUMMARY P.1").Select

End If

End Sub

And then here is the algorithm code:

Sub algorithm(x_count As Long, n As Long)

Dim item_a As String    'Letter part of Item
Dim item_b As String    'Number part of Item

        'If an "x" or "X" is marked in the "Yes" column,
        'at descending cells down the column offset by the for loop index, n

        If (ActiveCell.Offset(n, 0) = "x" Or ActiveCell.Offset(n, 0) = "X") Then

            item_a = ActiveCell.Offset(n, -3).Value     ' Store Letter value
            item_a = Replace(item_a, "(", "")           ' Get rid of "(", ")", and " " (space)
            item_a = Replace(item_a, ")", "")           ' characters that are grabbed
            item_a = Replace(item_a, " ", "")

            item_b = ActiveCell.Offset(n, -2).Value     ' Store number value
            item_b = Replace(item_b, "(", "")           ' Get rid of "(", ")", and " " (space)
            item_b = Replace(item_b, ")", "")           ' characters that are grabbed
            item_b = Replace(item_b, " ", "")

            x_count = x_count + 1                       ' increment the total x count

          If (x_count > 5) Then                       ' If there are more than 5 "x" marks,

              Sheets("SUMMARY P.2").Activate          ' then continue to log in SUMMARY P.2
              Range("A18").Select                     ' Choose "Item" column, first cell
              ActiveCell.Offset((x_count - 6), 0).Value = (item_a & item_b)

              'Insert cocatenated value of item_a and item_b
              '(for example "A" & "1" = "A1")
              'at the cells under the "Item" column, indexed by x_count

          Else                                        ' If there are less than 5 "x" marks,

              Sheets("SUMMARY P.1").Activate          ' log in SUMMARY P.1
              Range("A25").Select                     ' Choose "Item" column, first cell
              ActiveCell.Offset((x_count - 1), 0).Value = (item_a & item_b)

          End If

        End If

  n = n + 1

End Sub

tigeravatar · Accepted Answer · 2013-08-13T20:09:18.413

2

[EDIT]: Updated code based on new information:

Sub DSR_Autofill()

    Dim wsSummary1 As Worksheet
    Dim wsSummary2 As Worksheet
    Dim rngFound As Range
    Dim arrSummary1(1 To 5) As String
    Dim arrSummary2(1 To 65000) As String
    Dim strFirst As String
    Dim strTemp As String
    Dim DataIndex1 As Long
    Dim DataIndex2 As Long
    Dim xCount As Long
    Dim i As Long

    Set wsSummary1 = Sheets("SUMMARY P.1")
    Set wsSummary2 = Sheets("SUMMARY P.2")

    wsSummary1.Range("A25:A29").ClearContents
    wsSummary1.Range("A18:A" & Rows.Count).ClearContents

    For i = Sheets("Process Controls").Index To Sheets("Product Stewardship").Index
        With Sheets(i).Range("D15", Sheets(i).Cells(Rows.Count, "D").End(xlUp))
            Set rngFound = .Find("x", .Cells(.Cells.Count), xlValues, xlWhole)
            If Not rngFound Is Nothing Then
                strFirst = rngFound.Address
                Do
                    strTemp = Replace(Replace(Replace(Sheets(i).Cells(rngFound.Row, "A").Text & Sheets(i).Cells(rngFound.Row, "B").Text, "(", ""), ")", ""), " ", "")
                    If xCount < 5 Then
                        DataIndex1 = DataIndex1 + 1
                        arrSummary1(DataIndex1) = strTemp
                    Else
                        DataIndex2 = DataIndex2 + 1
                        arrSummary2(DataIndex2) = strTemp
                    End If
                    xCount = xCount + 1
                    Set rngFound = .Find("x", rngFound, xlValues, xlWhole)
                Loop While rngFound.Address <> strFirst
            End If
        End With
    Next i

    If DataIndex1 > 0 Then wsSummary1.Range("A25").Resize(DataIndex1).Value = Application.Transpose(arrSummary1)
    If DataIndex2 > 0 Then wsSummary2.Range("A18").Resize(DataIndex2).Value = Application.Transpose(arrSummary2)

    If xCount > 5 Then wsSummary2.Select Else wsSummary1.Select

End Sub

edited Aug 13 '13 at 20:09

answered Aug 09 '13 at 20:03

tigeravatar

26,199
5
30
38

This answer definitely improved my code, because now I can get the algorithm to work for one sheet, but still I have an error. It works if I comment out the "for" and "Next" lines and just reference "Sheets(5)" for instance. But as soon as I put the for loop back in, it does not work at all. – user2608147 Aug 13 '13 at 17:31
1

I can't really tell you anything more without seeing your code. Like I said, I have no idea what is in your "algorithm" code that is being called. It is likely that the problem is in there somewhere. – tigeravatar Aug 13 '13 at 17:33
I understand your code and its awesome, but do you know where the error is in my approach? – user2608147 Aug 13 '13 at 20:34
1

You were passing non-global variables (x_count and n in this case) to your second sub, and trying to update it there, instead of within your main sub. That means that those variables never got updated causing your work to not run properly. Generally speaking, global variables are frowned upon (though there are situations where they are called for), so I rewrote your code so that it didn't need them. I also saw no reason to have the algorithm secondary sub, so I just merged it with the main one. – tigeravatar Aug 13 '13 at 20:38
I see, one more question: whats the difference between using "with" before the worksheet and just ".select" ? – user2608147 Aug 13 '13 at 21:33
.select causes Excel to change which worksheet is currently selected (active, shown, etc). Generally speaking, always try to avoid the use of .select statements because they are largely unnecessary and slow the code down. With lets you access the object you invoked using With without having to specify each time. It's why I was able to use .Find without a qualifier, because it was being performed on the With object. – tigeravatar Aug 13 '13 at 21:41

Excel VBA: For loop to scan a set range of worksheets

1 Answers1