Find and Replace Code to Multiple Subs

pwill

Active Member
Joined
Nov 22, 2015
Messages
406
Hi can anyone help with replacing the lines in RED with the lines in Blue to multiple subs?

Code:
Sub dups1()

[COLOR=#ff0000]    Sheets("Sheet11").Select
    
    Dim Sheet11 As Worksheet: Set Sheet11 = Sheet11
    Dim lRow As Long
    
    lRow = Sheet11.Cells(Rows.Count, "A").End(xlUp).Row[/COLOR]
    Range("A1:BD" & lRow).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.AutoFilter
    ActiveSheet.Range("A1:BD" & lRow).AutoFilter Field:=3, Criteria1:="6"
    Selection.Copy
    Sheets("Sheet12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("Sheet11").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    Range("A1").Select
    
    Sheets("Sheet2").Select
End Sub

Code:
Sub dups2()

[COLOR=#0000ff]    Dim Sheet2 As Worksheet: Set Sheet2 = Sheet02
    Dim Sheet11 As Worksheet: Set Sheet11 = Sheet11
    Dim lRow As Long
  
        Application.ScreenUpdating = False
    
        lRow = Sheet11.Cells(Rows.Count, "A").End(xlUp).Row
        
    Sheet11.Activate[/COLOR]
    Range("A1:BD" & lRow).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.AutoFilter
    ActiveSheet.Range("A1:BD" & lRow).AutoFilter Field:=51, Criteria1:="-5"
    Selection.Copy
    Sheets("Sheet12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("Sheet11").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    Range("A1").Select
    
    Sheets("Sheet2").Select
    
End Sub


Any help would be appreciated

Regards

pwill
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
I would export the sub(s) then open in word, create the find replace, and then reimport, just need to tidy the lines together first so that it works first time
 
Upvote 0
I would export the sub(s) then open in word, create the find replace, and then reimport, just need to tidy the lines together first so that it works first time

Hi mole999, I have had a go on word but I really don't know where to start,

could you help with how to create the find and replace and any other tips you may have?

Regards

pwill
 
Upvote 0
Just tried it myself and its limited by the Paragraph mark so it won't find replace the whole text I wash hoping word would just except the whole text as tested.:( I don't have any better idea at the moment
 
Upvote 0
Thanks mole999 I will have a look at that much appreciated,

I did have an idea of my own that I gave a try this morning and all was going well until the end bit.


I have 210 subs all with the same code except for the Name and a different range for filtering, Sub names run from

Sub A1 to A30 then

B1 to 30,
C1 to 30,
D1 to 30,
E1 to 30,
F1 to 30,
G1 to 30

So what I did was keep the first sub how I want it then Counted the number of lines in the first Sub starting with the Sub name

ie

Code:
[/FONT][/COLOR][COLOR=#222222][FONT=Verdana]Sub A1()[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]    Dim Sht2 As Worksheet: Set2 Sht = Sheet02
    Dim Sht11 As Worksheet: Set Sht11 = Sheet11
    Dim Filtr As Worksheet: Set Filtr = Sheet14
    Dim C As Long
  
        Application.ScreenUpdating = False
  
            Sheets("Filtr").Range("A1:BD1" & Sheets("Filtr").Cells(Rows.Count, 2).End(3).Row) = ""
  
    CellCountB.Activate
          For C = 2 To 2
    
            Range("B1:BD1" & Cells(Rows.Count, 2).End(xlUp).Row).AutoFilter C - 1, 1
            Range("A1:BD" & Cells(Rows.Count, 2).End(xlUp).Row).Copy _
            Sheets("Filtr").Cells(Rows.Count, 1).End(3)(1)
                ActiveSheet.AutoFilterMode = False
   
          Next C
  
        Sht2.Activate
   
    Application.ScreenUpdating = True
   
End Sub[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana] [/FONT][/COLOR][COLOR=#222222][FONT=Verdana]


Then under the first Sub repeated a list of numbers x(209) with spaces as within the first sub and replaced the numbers with each line from the first Sub Starting with 'Sub A1'
the only problem is I was left with all the Subs having the same name which meant still having to scroll through them all to change the name and the ranges

ie

1
2
3
4

5

6

7
8

9
10
11
12

13

14

15

16
<strike></strike>
 
Upvote 0

Forum statistics

Threads
1,213,538
Messages
6,114,218
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