Run Same Code Multiple Times

mbpress01

New Member
Joined
Dec 30, 2017
Messages
20
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.

Code:
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.
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Hi,

There are multiple ways of doing this...

Code:
<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>
 
Upvote 0
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?
 
Upvote 0
Something like
Code:
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
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,531
Messages
6,114,167
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top