0

This code works on one sheet and now am trying get it to work across multiple sheets, avoiding the first two sheets ("AA" and "Word Frequency").

Original code here (See @Jeeped's answer)

Link to Worksheet here

Was trying to adapt code from related threads I found (Reference 1, 2) however I do not know how (and whether) to apply the Ws.Name and Ws.Range objects into my existing code.

It seems like the code activates Sheet1 using With Worksheets("Sheet1") and I was trying to replace this with the following method:

  1. Create For looped function byGroupCounter() to identify how many worksheets there are, and run across all existing worksheets. Each worksheet will be incremented with variable "i"

  2. For loop in byGroupCounter() calls on function byGroup(i) to run the original code on the selected worksheet (ie. worksheet "i")

  3. The byGroup() function runs it's process across worksheet i.

  4. Part where I believe I'm getting an error: Replacing the With Worksheets("Sheet1") code to With Ws, where Ws = Worksheets(Sheet_Index) and Sheet_Index is equal to i, defined from byGroupCounter()

I believe I have to add the Ws prefix in front of .Range but everything I've been trying, I keep getting the error "Can't execute code in break mode".

Current Code:

Sub byGroupCounter()

  Dim i As Integer

  Application.ScreenUpdating = False

For i = ActiveSheet.Index To Sheets.Count
  byGroup i
Next i
Application.ScreenUpdating = True
End Sub

Sub byGroup(ByVal Sheets_Index As Integer)
  Dim g As Long, s As Long, aSTRs As Variant, aGRPs As Variant
  Dim Ws As Worksheet
  Set Ws = Worksheets(Sheet_Index)

appTGGL bTGGL:=False

' I believe the next line is where I am doing something wrong:
With Ws
    aSTRs = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).Value2
    With .Range(.Cells(1, 5), .Cells(Rows.Count, 1).End(xlUp).Offset(0,        Application.Match("zzz", .Rows(1)) - 1))
        .Resize(.Rows.Count, .Columns.Count).Offset(1, 0).ClearContents
        aGRPs = Ws.Cells.Value2
    End With

    For s = LBound(aSTRs, 1) To UBound(aSTRs, 1)
        For g = LBound(aGRPs, 2) To UBound(aGRPs, 2)
            If CBool(InStr(1, aSTRs(s, 1), aGRPs(1, g), vbTextCompare)) Then
                aGRPs(s + 1, g) = aSTRs(s, 1)
                Exit For
            End If
        Next g
    Next s

    .Cells(1, 5).Resize(UBound(aGRPs, 1), UBound(aGRPs, 2)) = aGRPs

  End With

  appTGGL
End Sub

Public Sub appTGGL(Optional bTGGL As Boolean = True)
    Debug.Print Timer
    Application.ScreenUpdating = bTGGL
    Application.EnableEvents = bTGGL
    Application.DisplayAlerts = bTGGL
    Application.Calculation = IIf(bTGGL, xlCalculationAutomatic,     xlCalculationManual)
End Sub
Community
  • 1
  • 1
sikorloa
  • 101
  • 13

1 Answers1

1

There are just 6 changes to the original code to loop through the sheets

I have them commented with '<<<

Sub byGroup()
    Dim g As Long, s As Long, aSTRs As Variant, aGRPs As Variant, sh As Worksheet    '<<<

    appTGGL bTGGL:=False
    For Each sh In Sheets    '<<<
        If sh.Name <> "AA" And sh.Name <> "Word Frequency" Then    '<<<<
            With sh    '<<<
                aSTRs = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).Value2
                With .Range(.Cells(1, 5), .Cells(Rows.Count, 1).End(xlUp).Offset(0, Application.Match("zzz", .Rows(1)) - 1))
                    .Resize(.Rows.Count, .Columns.Count).Offset(1, 0).ClearContents
                    aGRPs = .Cells.Value2
                End With

                For s = LBound(aSTRs, 1) To UBound(aSTRs, 1)
                    For g = LBound(aGRPs, 2) To UBound(aGRPs, 2)
                        If CBool(InStr(1, aSTRs(s, 1), aGRPs(1, g), vbTextCompare)) Then
                            aGRPs(s + 1, g) = aSTRs(s, 1)
                            Exit For
                        End If
                    Next g
                Next s

                .Cells(1, 5).Resize(UBound(aGRPs, 1), UBound(aGRPs, 2)) = aGRPs

            End With
        End If    '<<<<
    Next sh    '<<<
    appTGGL
End Sub

Public Sub appTGGL(Optional bTGGL As Boolean = True)
    Debug.Print Timer
    Application.ScreenUpdating = bTGGL
    Application.EnableEvents = bTGGL
    Application.DisplayAlerts = bTGGL
    Application.Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
End Sub
Davesexcel
  • 6,896
  • 2
  • 27
  • 42
  • Forgot to add code to skip `AA` and `Word Frequency` worksheets? – PatricK Jan 21 '16 at 06:28
  • Edited to avoid Sheets "AA" and "Word Frequency" – Davesexcel Jan 21 '16 at 06:46
  • Works great, thank you! Also many thanks for the comments, it's great to finally understand how I can use the same loop with the 'For Each sh in Sheets' and 'With sh'... wasn't sure about the structure but this makes it very clear – sikorloa Jan 21 '16 at 16:16