run command on multiple sheets at once

I have a code that is set to autorun on open but need the command to run for one sheet and then another. when I choose to activate the second sheet and run the command again i get the following Compile Error: Duplicate declaration in current scope. Here is the code.

Private Sub Workbook_Open()
Workbooks("Master Inventory Report PO numbers.xlsm").RefreshAll
Worksheets("Filled POs").Activate
 Range("C1:C99999").Select
    Selection.ClearContents
    Const HEADER_ROWS As Long = 1
  Const OUTPUT_TO_COLUMN As Long = 3
  Const DELIMITER As String = vbNewLine
  Dim A_Range As Range
  Dim B_Range As Range
  Dim A_temp As Range
  Dim B_temp As Range
  Dim B_Cell As Range
  Dim Concat As String

On Error GoTo Whoops
  Set A_Range = Range("A1").Offset(HEADER_ROWS)
  Do While Not A_Range Is Nothing
    Set B_Range = A_Range.Offset(0, 1)

    ' some helper ranges
    If A_Range.Offset(1, 0).Value = "" Then
      Set A_temp = Range(A_Range, A_Range.End(xlDown).Offset(-1, 0))
    Else
      Set A_temp = A_Range.Offset(1, 0)
    End If
    Set B_temp = Range(B_Range, B_Range.End(xlDown)).Offset(0, -1)

    ' determine how high "B" is WRT no change in "A"
    Set B_Range = Range(B_Range, B_Range.Resize( _
      Application.Intersect(A_temp, B_temp, ActiveSheet.UsedRange).Count))

    ' loop through "B" and build up the string
    Concat = ""
    For Each B_Cell In B_Range
      Concat = Concat & B_Cell.Value & DELIMITER
    Next
    Concat = Left(Concat, Len(Concat) - Len(DELIMITER))

    ' do the needful
    A_Range.Offset(0, OUTPUT_TO_COLUMN - 1).Value = Concat

    ' find the next change in "A"
    If A_Range.Offset(1, 0).Value = "" Then
      Set A_Range = Application.Intersect(A_Range.End(xlDown), ActiveSheet.UsedRange)
    Else
      Set A_Range = A_Range.Offset(1, 0)
    End If
 Loop
 

 
  Worksheets("Due POS").Activate
      Selection.ClearContents
    Const HEADER_ROWS As Long = 1
  Const OUTPUT_TO_COLUMN As Long = 3
  Const DELIMITER As String = vbNewLine
  Dim A_Range As Range
  Dim B_Range As Range
  Dim A_temp As Range
  Dim B_temp As Range
  Dim B_Cell As Range
  Dim Concat As String

On Error GoTo Whoops
  Set A_Range = Range("A1").Offset(HEADER_ROWS)
  Do While Not A_Range Is Nothing
    Set B_Range = A_Range.Offset(0, 1)

    ' some helper ranges
    If A_Range.Offset(1, 0).Value = "" Then
      Set A_temp = Range(A_Range, A_Range.End(xlDown).Offset(-1, 0))
    Else
      Set A_temp = A_Range.Offset(1, 0)
    End If
    Set B_temp = Range(B_Range, B_Range.End(xlDown)).Offset(0, -1)

    ' determine how high "B" is WRT no change in "A"
    Set B_Range = Range(B_Range, B_Range.Resize( _
      Application.Intersect(A_temp, B_temp, ActiveSheet.UsedRange).Count))

    ' loop through "B" and build up the string
    Concat = ""
    For Each B_Cell In B_Range
      Concat = Concat & B_Cell.Value & DELIMITER
    Next
    Concat = Left(Concat, Len(Concat) - Len(DELIMITER))

    ' do the needful
    A_Range.Offset(0, OUTPUT_TO_COLUMN - 1).Value = Concat

    ' find the next change in "A"
    If A_Range.Offset(1, 0).Value = "" Then
      Set A_Range = Application.Intersect(A_Range.End(xlDown), ActiveSheet.UsedRange)
    Else
      Set A_Range = A_Range.Offset(1, 0)
    End If
 Loop
 
  Exit Sub
Whoops:
  MsgBox (Err & "WTF" & Error)
  Stop
  Resume Next
 

End Sub
natevelli2Asked:
Who is Participating?
 
NorieVBA ExpertCommented:
Instead of repeating the code for each worksheets you can loop through the worksheets and then run the code on each one.
Option Explicit

Private Sub Workbook_Open()
Const HEADER_ROWS As Long = 1
Const OUTPUT_TO_COLUMN As Long = 3
Const DELIMITER As String = vbNewLine
Dim ws As Worksheet
Dim A_Range As Range
Dim B_Range As Range
Dim A_temp As Range
Dim B_temp As Range
Dim B_Cell As Range
Dim Concat As String
Dim arrWSNames
Dim I As Long

    Workbooks("Master Inventory Report PO numbers.xlsm").RefreshAll

    arrWSNames = Array("Filled POs", "Due POS")

    For I = LBound(arrWSNames) To UBound(arrWSNames)

        Set ws = Worksheets(arrWSNames(I))
        
        ws.Range("C1:C99999").ClearContents

        On Error GoTo Whoops
        Set A_Range = ws.Range("A1").Offset(HEADER_ROWS)
        Do While Not A_Range Is Nothing
            Set B_Range = A_Range.Offset(0, 1)

            ' some helper ranges
            If A_Range.Offset(1, 0).Value = "" Then
                Set A_temp = Range(A_Range, A_Range.End(xlDown).Offset(-1, 0))
            Else
                Set A_temp = A_Range.Offset(1, 0)
            End If
            Set B_temp = Range(B_Range, B_Range.End(xlDown)).Offset(0, -1)

            ' determine how high "B" is WRT no change in "A"
            Set B_Range = Range(B_Range, B_Range.Resize( _
                                         Application.Intersect(A_temp, B_temp, ws.UsedRange).Count))

            ' loop through "B" and build up the string
            Concat = ""
            For Each B_Cell In B_Range
                Concat = Concat & B_Cell.Value & DELIMITER
            Next
            Concat = Left(Concat, Len(Concat) - Len(DELIMITER))

            ' do the needful
            A_Range.Offset(0, OUTPUT_TO_COLUMN - 1).Value = Concat

            ' find the next change in "A"
            If A_Range.Offset(1, 0).Value = "" Then
                Set A_Range = Application.Intersect(A_Range.End(xlDown), ws.UsedRange)
            Else
                Set A_Range = A_Range.Offset(1, 0)
            End If
        Loop

    Next I

    Exit Sub
Whoops:
    MsgBox (Err & "WTF" & Error)
    Stop
    Resume Next


End Sub

Open in new window

0
 
ScriptAddictCommented:
Sounds like your declaring variables that are already active.

Check out this page.

http://www.ozgrid.com/VBA/variable-scope-lifetime.htm

try commenting out your constants.  It code be since you don't dim those, they carry over.  

-SA
0
 
natevelli2Author Commented:
Worked like a charm. Thank you
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.