Repeating a Macro across an Entire Workbook

[Nicole_Michelle01]

I have 5 worksheets (Sheet1, Sheet2, Sheet3, Sheet4, Sheet5) and I want the following macro run for each worksheet:

Sub SetupFile()
For intcount = 1 To 256
If InStr(1, Cells(1, intcount), "userpsswd") > 0 Then
Cells(1, intcount).EntireColumn.Delete
End If
Next intcount
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A1").Select
ActiveCell.FormulaR1C1 = "Review Notes"
Columns("A:A").Select
Selection.Columns.AutoFit
Columns("E:E").Select
Selection.Insert Shift:=xlToRight
Range("E1").Select
ActiveCell.FormulaR1C1 = "Dept."
End Sub

And also, if I want to add additional keywords to the InStr row ie "userpsswd" "psswd_expdate" "psswd_createdate", what would that look like?

thanks!

 

[Barrie Davidson]

Okay, try this and let me know how it works out.

Option Explicit
Sub SetupAllFiles()
Dim ws As Worksheet
Dim SearchWord, i As Integer

Application.ScreenUpdating = False
SearchWord = Array("keyword1", "keyword2", "keyword3", "keyword4")
For i = 0 To UBound(SearchWord)
    For Each ws In ActiveWorkbook.Worksheets
        Call SetupFile(SearchWord(i), ws)
    Next ws
Next i
Application.ScreenUpdating = True
End Sub


Sub SetupFile(KeywordPassed, ActiveWs As Worksheet)
Dim intcount As Integer

For intcount = 1 To 256
    If InStr(1, ActiveWs.Cells(1, intcount), KeywordPassed) > 0 Then
        ActiveWs.Cells(1, intcount).EntireColumn.Delete
    End If
Next intcount
ActiveWs.Columns("A:A").Insert Shift:=xlToRight
ActiveWs.Range("A1").FormulaR1C1 = "Review Notes"
ActiveWs.Columns("A:A").Columns.AutoFit
ActiveWs.Columns("E:E").Insert Shift:=xlToRight
ActiveWs.Range("E1").FormulaR1C1 = "Dept."
End Sub

Regards,

 

[Nicole_Michelle01]

...one other thing, the keyword is triggering a delete of other columns containing the same keyword in the header

 

[Nicole_Michelle01]

and that code works perfectly, by the way - thanks!

 

[Barrie Davidson]

...one other thing, the keyword is triggering a delete of other columns containing the same keyword in the header

and that code works perfectly, by the way - thanks!

So it's working?

 

[Nicole_Michelle01]

Now I added the keywords and it's deleting all the data on every worksheet except one:

Option Explicit
Sub SetupAllFiles()
Dim ws As Worksheet
Dim SearchWord, i As Integer

Application.ScreenUpdating = False
SearchWord = Array("emp_title", "hiredate", "lastincdate", "lastincpct", "psswd_expdate", "staffaddress1", "staffaddress2", "staffcity", "staffcomment", "staffgrade", "staffphone", "staffsalary", "staffssno", "staffstate", "staffzip", "userpsswd")
For i = 0 To UBound(SearchWord)
For Each ws In ActiveWorkbook.Worksheets
Call SetupFile(SearchWord(i), ws)
Next ws
Next i
Application.ScreenUpdating = True
End Sub

Sub SetupFile(KeywordPassed, ActiveWs As Worksheet)
Dim intcount As Integer

For intcount = 1 To 256
If InStr(1, ActiveWs.Cells(1, intcount), KeywordPassed) > 0 Then
ActiveWs.Cells(1, intcount).EntireColumn.Delete
End If
Next intcount
ActiveWs.Columns("A:A").Insert Shift:=xlToRight
ActiveWs.Range("A1").FormulaR1C1 = "Review Notes"
ActiveWs.Columns("A:A").Columns.AutoFit
ActiveWs.Columns("E:E").Insert Shift:=xlToRight
ActiveWs.Range("E1").FormulaR1C1 = "Dept."
End Sub

what did I do wrong?

 

[Nicole_Michelle01]

all the columns and data are deleted and Review Notes and Dept is repeated across all columns on each worksheet

 

[Barrie Davidson]

YIKES That's the hazard of trying to solve a problem without real data.

How about this?

Option Explicit
Sub SetupAllFiles()
Dim ws As Worksheet
Dim SearchWord, i As Integer

Application.ScreenUpdating = False
SearchWord = Array("keyword1", "keyword2", "keyword3", "keyword4")
For Each ws In ActiveWorkbook.Worksheets
    For i = 0 To UBound(SearchWord)
        Call SetupFile(SearchWord(i), ws)
    Next i
    ws.Columns("A:A").Insert Shift:=xlToRight
    ws.Range("A1").FormulaR1C1 = "Review Notes"
    ws.Columns("A:A").Columns.AutoFit
    ws.Columns("E:E").Insert Shift:=xlToRight
    ws.Range("E1").FormulaR1C1 = "Dept."
Next ws
Application.ScreenUpdating = True
End Sub


Sub SetupFile(KeywordPassed, ActiveWs As Worksheet)
Dim intcount As Integer

For intcount = 1 To 256
    If InStr(1, ActiveWs.Cells(1, intcount), KeywordPassed) > 0 Then
        ActiveWs.Cells(1, intcount).EntireColumn.Delete
    End If
Next intcount
End Sub

 

[Nicole_Michelle01]

i know, sorry about that, let me try this now...you rock!

 

[Nicole_Michelle01]

it works except for one of them, emp_title.

There are three headers with "emp_title" in the header

COLY: emp_title_collec, COLZ: emp_title_limit, COLAA: emp_title

of the three, it is deleting emp_title_collec (which is incorrect) and emp_title (which is correct)

 

[Barrie Davidson]

it works except for one of them, emp_title.

There are three headers with "emp_title" in the header

COLY: emp_title_collec, COLZ: emp_title_limit, COLAA: emp_title

of the three, it is deleting emp_title_collec (which is incorrect) and emp_title (which is correct)

Okay, so you're deleting exact matches only (by the way, your first code doesn't do that)?