VBA not working on both sheets

[john3j]

Hello, I have the following code:


Option Explicit
Sub SortAndColor()
Dim LastRow As Long, Rw As Long, a As Long
Dim MySheets
MySheets = Array("Master", "Seaport-e")
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, 39).Value, "*If chosen") > 0 Then
Cells(Rw, 1).EntireRow.Delete
Else
Select Case Cells(Rw, 39).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


The first two sheets of the workbook are named "Master" and "Seaport-e". The code runs through and does all of the color coding on the sheet called "Master" but does nothing on the "Seaport-e" one. I do not recieve any errors. Any help would be appreciated.

Thanks

[Bob Phillips]

John,

I have just tried it on an example and it worked for both sheets.

Can you post your workbook?

[will1128]

Try replacing
Dim MySheets
to
Dim MySheets AS Worksheet
in the For statement try
For Each Mysheets in ActiveWorkbook.Worksheets
LastRow = Cells(Rows.Count, 7).End(xlUp).Row

[geekgirlau]

Untested, but you need to refer explicitly to the sheet you're talking about (using Cells for example - cells of which sheet?).


Option Explicit
Sub SortAndColor()
Dim LastRow As Long, Rw As Long, a As Long
Dim MySheets() As Worksheet

MySheets = Array("Master", "Seaport-e")

For a = LBound(MySheets) To UBound(MySheets)
With Sheets(MySheets(a))
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, 39).Value, "*If chosen") > 0 Then
.Cells(Rw, 1).EntireRow.Delete
Else
Select Case .Cells(Rw, 39).Value
Case "Contract Awarded": .Rows(Rw).Interior.ColorIndex = 35
Case "Part A Held": .Rows(Rw).Interior.ColorIndex = 34
Case "Part B Accepted": .Rows(Rw).Interior.ColorIndex = 38
Case "Part B Submitted": .Rows(Rw).Interior.ColorIndex = 36
Case "Planning": .Rows(Rw).Interior.ColorIndex = 2
Case "Postponed": .Rows(Rw).Interior.ColorIndex = 39
End Select

.Rows(Rw).Font.ColorIndex = 1
.Rows(Rw).Borders.LineStyle = xlContinuous
End If
Next Rw
End With
Next a
End Sub

[hitech]

You may change the name Seaport-e to Seaporte. I hope it will work.

[mohanvijay]

try loop through sheets like this




for a = 1 to sheets.count
sheets(a).activate
'your code

next a