Solved: modify code to run on several sheets in a workbook

[john3j]

Hey guys,

I have the following code that color codes rows based on criteria in a specific column. I was just wondering if someone could help me find a way to run this code on multiple sheets of the workbook. Lets say I have 5 sheets in the workbook, and the names are as follows:
Test1, Test2, Example1, Example2, and Trouble1.


Sub SortAndColor()
LastRow = Cells(Rows.Count, 3).End(xlUp).Row
For Rw = LastRow To 2 Step -1
If Cells(Rw, 7).Value <= "09" Or InStr(Cells(Rw, 38).Value, "*If chosen") > 0 Then
Cells(Rw, 1).EntireRow.Delete
Else
Select Case Cells(Rw, 38).Value
Case "Contract Awarded"
Rows(Rw).Interior.ColorIndex = 35
Rows(Rw).Font.ColorIndex = 1
Rows(Rw).Borders.LineStyle = xlContinuous
Case "Part A Held"
Rows(Rw).Interior.ColorIndex = 34
Rows(Rw).Font.ColorIndex = 1
Rows(Rw).Borders.LineStyle = xlContinuous
Case "Part B Accepted"
Rows(Rw).Interior.ColorIndex = 38
Rows(Rw).Font.ColorIndex = 1
Rows(Rw).Borders.LineStyle = xlContinuous
Case "Part B Submitted"
Rows(Rw).Interior.ColorIndex = 36
Rows(Rw).Font.ColorIndex = 1
Rows(Rw).Borders.LineStyle = xlContinuous
Case "Planning"
Rows(Rw).Interior.ColorIndex = 2
Rows(Rw).Font.ColorIndex = 1
Rows(Rw).Borders.LineStyle = xlContinuous
Case "Postponed"
Rows(Rw).Interior.ColorIndex = 39
Rows(Rw).Font.ColorIndex = 1
Rows(Rw).Borders.LineStyle = xlContinuous
End Select
End If
Next
End Sub

I dont really need the part that deletes items that are less that equal to "09" so if someone could, help me modify the code to remove that and run on the listed sheets above. Thank you!

[GTO]

Greetings John,

Not tested - but I think I got the IF test correct. Anyways, in a junk copy of your workbook, try:

In a Standard Module:

Sub Main()
Dim ary
Dim i As Long

ary = Array("Test1", "Test2", "Example1", "Example2", "Trouble1")
For i = LBound(ary) To UBound(ary)
If Not SortAndColor(ary(i)) Then
MsgBox _
"There was a problem running ""SortAndColor()"" on sheet: " & ary(i) & "." & _
vbCrLf & "I will now exit...", vbCritical, vbNullString

Exit For 'or: Exit Sub
End If
Next
End Sub

Function SortAndColor(ByVal strWksName As String) As Boolean
Dim wks As Worksheet
Dim LastRow As Long, Rw As Long

On Error GoTo Bail

Set wks = ThisWorkbook.Worksheets(strWksName)
With wks
LastRow = .Cells(Rows.Count, 3).End(xlUp).Row

For Rw = LastRow To 2 Step -1
If .Cells(Rw, 7).Value > "09" _
Or InStr(.Cells(Rw, 38).Value, "*If chosen") = 0 Then
Select Case Cells(Rw, 38).Value
Case "Contract Awarded"
.Rows(Rw).Interior.ColorIndex = 35
.Rows(Rw).Font.ColorIndex = 1
.Rows(Rw).Borders.LineStyle = xlContinuous
Case "Part A Held"
.Rows(Rw).Interior.ColorIndex = 34
.Rows(Rw).Font.ColorIndex = 1
.Rows(Rw).Borders.LineStyle = xlContinuous
Case "Part B Accepted"
.Rows(Rw).Interior.ColorIndex = 38
.Rows(Rw).Font.ColorIndex = 1
.Rows(Rw).Borders.LineStyle = xlContinuous
Case "Part B Submitted"
.Rows(Rw).Interior.ColorIndex = 36
.Rows(Rw).Font.ColorIndex = 1
.Rows(Rw).Borders.LineStyle = xlContinuous
Case "Planning"
.Rows(Rw).Interior.ColorIndex = 2
.Rows(Rw).Font.ColorIndex = 1
.Rows(Rw).Borders.LineStyle = xlContinuous
Case "Postponed"
.Rows(Rw).Interior.ColorIndex = 39
.Rows(Rw).Font.ColorIndex = 1
.Rows(Rw).Borders.LineStyle = xlContinuous
End Select
End If
Next
End With
On Error GoTo 0
SortAndColor = True
Exit Function
Bail:
SortAndColor = False
End Function



Does that help?

Mark

[stanleydgrom]

john3j,

Try:

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).




Option Explicit
Sub SortAndColor()
Dim LastRow As Long, Rw As Long, a As Long
Dim MySheets
MySheets = Array("Test1", "Test2", "Example1", "Example2", "Trouble1")
For a = LBound(MySheets) To UBound(MySheets)
Sheets(MySheets(a)).Select
LastRow = Cells(Rows.Count, 3).End(xlUp).Row
For Rw = LastRow To 2 Step -1
If Cells(Rw, 7).Value <= "09" Or InStr(Cells(Rw, 38).Value, "*If chosen") > 0 Then
Cells(Rw, 1).EntireRow.Delete
Else
Select Case Cells(Rw, 38).Value
Case "Contract Awarded"
Rows(Rw).Interior.ColorIndex = 35
Rows(Rw).Font.ColorIndex = 1
Rows(Rw).Borders.LineStyle = xlContinuous
Case "Part A Held"
Rows(Rw).Interior.ColorIndex = 34
Rows(Rw).Font.ColorIndex = 1
Rows(Rw).Borders.LineStyle = xlContinuous
Case "Part B Accepted"
Rows(Rw).Interior.ColorIndex = 38
Rows(Rw).Font.ColorIndex = 1
Rows(Rw).Borders.LineStyle = xlContinuous
Case "Part B Submitted"
Rows(Rw).Interior.ColorIndex = 36
Rows(Rw).Font.ColorIndex = 1
Rows(Rw).Borders.LineStyle = xlContinuous
Case "Planning"
Rows(Rw).Interior.ColorIndex = 2
Rows(Rw).Font.ColorIndex = 1
Rows(Rw).Borders.LineStyle = xlContinuous
Case "Postponed"
Rows(Rw).Interior.ColorIndex = 39
Rows(Rw).Font.ColorIndex = 1
Rows(Rw).Borders.LineStyle = xlContinuous
End Select
End If
Next
Next a
End Sub

[austenr]

Does this help?

Worksheets("Test1").Cells(1,1)

You could use a function for each sheet or if the cells are the same for each sheet, try using all the sheets within the parenthesis.

[parttime_guy]

Hi John,

Try using this sub - copy paste only your formatting code in the sub.

Hope this helps!

Best Regards



Sub Format_all_Sheets()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
With ws
'===============Paste your code below

'===============End your code here
End With
Next ws
End Sub

[john3j]

I have tried what all of you are saying and I cant get it to work. I have attached a desensitised workbook that we can test with. If anyone can get it to work I would be greatly appreciative. I would like to make sure that if I added a worksheet later on, or a chart, that the code would not do anything to those sheets. So we need to make sure that it only runs on the specified sheets (Test1, Test2, Example1, Example2, and Trouble1).

Thanks!

[austenr]

What results if any, do you get when you run any of the suggested code above?

[john3j]

Nothing happens at all. Nothing that I can tell at least.

[GTO]

In your test wb, put any value (such as "xxx") in row 289, column 3 (Col C), on each sheet.

Just barely tested, but I suspect that:

LastRow = .Cells(Rows.Count, 3).End(xlUp).Row

...is the problem. This looks from the bottom up of Col C. You don't have any values there for it to find.

With your test wb, I think that you are attempting PartTime's suggestion. To use the With, you need to qualify the effected code like .Cells, .Rows etc.

Hope that helps,

Mark

[stanleydgrom]

john3j,

In your workbook, you are using column C to find the last row. Column C is blank. I have adjusted the code to look at column G.

See the attached workbook "testbook(1) - john3j - SDG09.xls" with changes to your "Format_all_Sheets" macro.


Then run the ""Format_all_Sheets" macro.





Option Explicit
Sub Format_all_Sheets()
Dim ws As Worksheet, LastRow As Long, Rw As Long
For Each ws In ActiveWorkbook.Worksheets
With ws
'LastRow = .Cells(Rows.Count, 3).End(xlUp).Row
LastRow = .Cells(Rows.Count, 7).End(xlUp).Row

For Rw = LastRow To 2 Step -1
If .Cells(Rw, 7).Value <= "09" Or InStr(.Cells(Rw, 38).Value, "*If chosen") > 0 Then
.Cells(Rw, 1).EntireRow.Delete
Else
Select Case .Cells(Rw, 38).Value
Case "Contract Awarded"
Rows(Rw).Interior.ColorIndex = 35
Rows(Rw).Font.ColorIndex = 1
Rows(Rw).Borders.LineStyle = xlContinuous
Case "Part A Held"
Rows(Rw).Interior.ColorIndex = 34
Rows(Rw).Font.ColorIndex = 1
Rows(Rw).Borders.LineStyle = xlContinuous
Case "Part B Accepted"
Rows(Rw).Interior.ColorIndex = 38
Rows(Rw).Font.ColorIndex = 1
Rows(Rw).Borders.LineStyle = xlContinuous
Case "Part B Submitted"
Rows(Rw).Interior.ColorIndex = 36
Rows(Rw).Font.ColorIndex = 1
Rows(Rw).Borders.LineStyle = xlContinuous
Case "Planning"
Rows(Rw).Interior.ColorIndex = 2
Rows(Rw).Font.ColorIndex = 1
Rows(Rw).Borders.LineStyle = xlContinuous
Case "Postponed"
Rows(Rw).Interior.ColorIndex = 39
Rows(Rw).Font.ColorIndex = 1
Rows(Rw).Borders.LineStyle = xlContinuous
End Select
End If
Next
End With
Next ws
End Sub




Have a great day,
Stan

[john3j]

You guys are awesome. You were right, changing it to row 7 fixed the issue. I used the following code to run it on all of the sheets:

Option Explicit
Sub SortAndColor()
Dim LastRow As Long, Rw As Long, a As Long
Dim MySheets
MySheets = Array("Test1", "Test2", "Example1", "Example2", "Trouble1")
For a = LBound(MySheets) To UBound(MySheets)
Sheets(MySheets(a)).Select
LastRow = Cells(Rows.Count, 7).End(xlUp).Row
For Rw = LastRow To 2 Step -1
If Cells(Rw, 7).Value <= "09" Or InStr(Cells(Rw, 38).Value, "*If chosen") > 0 Then
Cells(Rw, 1).EntireRow.Delete
Else
Select Case Cells(Rw, 38).Value
Case "Contract Awarded"
Rows(Rw).Interior.ColorIndex = 35
Rows(Rw).Font.ColorIndex = 1
Rows(Rw).Borders.LineStyle = xlContinuous
Case "Part A Held"
Rows(Rw).Interior.ColorIndex = 34
Rows(Rw).Font.ColorIndex = 1
Rows(Rw).Borders.LineStyle = xlContinuous
Case "Part B Accepted"
Rows(Rw).Interior.ColorIndex = 38
Rows(Rw).Font.ColorIndex = 1
Rows(Rw).Borders.LineStyle = xlContinuous
Case "Part B Submitted"
Rows(Rw).Interior.ColorIndex = 36
Rows(Rw).Font.ColorIndex = 1
Rows(Rw).Borders.LineStyle = xlContinuous
Case "Planning"
Rows(Rw).Interior.ColorIndex = 2
Rows(Rw).Font.ColorIndex = 1
Rows(Rw).Borders.LineStyle = xlContinuous
Case "Postponed"
Rows(Rw).Interior.ColorIndex = 39
Rows(Rw).Font.ColorIndex = 1
Rows(Rw).Borders.LineStyle = xlContinuous
End Select
End If
Next
Next a
End Sub