Run Same Code Multiple Times

[mbpress01]

I have the following procedure that works well but my problem is that I need to have the same procedure run on different worksheets within the same workbook. I have tried Arrays unsuccessfully (as I am not good enough at programming) and resorted to copying the same procedure 8 times for the 8 number of worksheets that I have.

There is zero change in rows, columns and procedures; the only thing that is changing is the worksheet name. I was wondering if someone could lead me down the correct path on how to have an array or other type of procedure so I won’t have 8 separate procedures for EXACTLY the same code. Generally, is there any "bullet proof" way to have a procedures run the exact same code with different worksheets.

One thought was using a variable for the sheet name but that i believe gets back to arrays and my attempts kept failing so i just resorted to copying the below code 8 times and change the worksheet name.

Sub Copy_PasteData()
Dim LRow As Long

Worksheets("REG_DataSrc").Activate  '<------this REG_DataSrc will change to MID_DataSrc, etc etc 
Worksheets("REG_DataSrc").Range("B10:F100").ClearContents  '<-------this REG_DataSrc will change to MID_DataSrc, etc etc 

Worksheets("EzeSrc").Activate
With Worksheets("EzeSrc")
  LRow = Worksheets("EzeSrc").Cells(.Rows.Count, "M").End(xlUp).Row
  'Debug.Print LRow
End With

' new autofilter code to select unique items, copy to sheet
  Worksheets("EzeSrc").Range("AH10:AL100").ClearContents

On Error Resume Next
  If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
    ActiveSheet.ShowAllData
  End If

'to filter the first list
Worksheets("EzeSrc").Range("M9", Range("Q9").End(xlDown)).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("AH1:AJ2"), CopyToRange:=Range("AH9:AL9"), Unique:=False
Worksheets("EzeSrc").Range("AH10:AL100").Copy Destination:=Worksheets("REG_DataSrc").Range("B10") '<------this REG_DataSrc will change to MID_DataSrc, etc etc 
     
End Sub

Any help/thoughts appreciated.

 

[hearthhrob4gals]

Hi,

There are multiple ways of doing this...

<code class="x-hidden-focus" style="box-sizing: inherit; font-size: 1em; font-family: Consolas, "Courier New", Courier, monospace;"> WS_Count = ActiveWorkbook.Worksheets.Count

         For I = 1 To WS_Count
            stname= ActiveWorkbook.Worksheets(I).Name
  'paste your code here...replace your sheetname with stname
       
         Next I</code>

 

[mbpress01]

Right, the worksheets count would work but I should have mentioned that there are other data worksheets so the code shouldn't loop through all the worksheets in the workbook. Just the ones that need the code applied to. I realize its annoying with changing requirements so I figured i would respond directly since it is not clear from the code. Any other ideas?

 

[Fluff]

Something like

Dim LRow As Long
Dim Sht As Variant

For Each Sht In Array("REG_DataSrc", "Master", "New")
   Sheets(Sht).Range("B10:F100").ClearContents
   'do something
Next Sht

 

[mbpress01]

Thx Fluff, that should work really well. Is it fair to say that a For Each Loop with an array is the best way to do this or is there other examples that you can generally think of for further investigation. The code above seems fantastic for same procedure different sheet processing. If you can think of anything else, please post and as always thanks for the response.

 

[Fluff]

Often there is no "Best" way of doing something, as it largely depends on the situation. If you only want to run through a few sheets this way is probably as good as any.
However if you have (say) 100 sheets & want to run through all but few, then another option maybe better.