or ...
Sub Update_Row_Colors(SH As Worksheet)
Dim LRow As Integer
Dim LCell As String
Dim LColorCells As String
'Start at row 7
LRow = 7
'Update row colors for the first 1000 rows
With SH
While LRow < 1000
LCell = "H" & LRow
'Color will change in columns A to CV
LColorCells = "A" & LRow & ":" & "CV" & LRow
Select Case Left(.Range(LCell).Value, 6)
'Set row color to yellow
Case "H"
.Range(LColorCells).Interior.ColorIndex = 6
.Range(LColorCells).Interior.Pattern = xlSolid
'Set row color to red
Case "C"
'.Rows(LRow & ":" & LRow).Select
.Range(LColorCells).Interior.ColorIndex = 3
.Range(LColorCells).Interior.Pattern = xlSolid
'Set row color to gray
Case "S"
'.Rows(LRow & ":" & LRow).Select
.Range(LColorCells).Interior.ColorIndex = 15
.Range(LColorCells).Interior.Pattern = xlSolid
'Default all other rows to no color
Case Else
'.Rows(LRow & ":" & LRow).Select
.Range(LColorCells).Interior.ColorIndex = xlNone
End Select
LRow = LRow + 1
Wend
End With
End Sub
Sub LoopThroughSheets()
Dim ws As Worksheet
Dim SH As Worksheet
Set SH = ActiveSheet
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
Update_Row_Colors ws
'** Perform code here **
'E.g.
On Error Resume Next 'Will continue if an error results
ws.Range("A1") = ws.Name
'***********************
Next ws
SH.Select
Application.ScreenUpdating = True
End Sub
regards
r
--
Come e dove incollare il codice:
http://www.rondebruin.nl/code.htm
Il mio ultimo lavoro ...
http://excelvba.altervista.org/blog/...ternative.html
"Melanie" wrote:
I have a code that I have perfected to work, but I cannot find the right
way to have it loop thru several worksheets. My code is as follows:
Sub Update_Row_Colors()
Dim LRow As Integer
Dim LCell As String
Dim LColorCells As String
'Start at row 7
LRow = 7
'Update row colors for the first 1000 rows
While LRow < 1000
LCell = "H" & LRow
'Color will change in columns A to CV
LColorCells = "A" & LRow & ":" & "CV" & LRow
Select Case Left(Range(LCell).Value, 6)
'Set row color to yellow
Case "H"
Range(LColorCells).Interior.ColorIndex = 6
Range(LColorCells).Interior.Pattern = xlSolid
'Set row color to red
Case "C"
Rows(LRow & ":" & LRow).Select
Range(LColorCells).Interior.ColorIndex = 3
Range(LColorCells).Interior.Pattern = xlSolid
'Set row color to gray
Case "S"
Rows(LRow & ":" & LRow).Select
Range(LColorCells).Interior.ColorIndex = 15
Range(LColorCells).Interior.Pattern = xlSolid
'Default all other rows to no color
Case Else
Rows(LRow & ":" & LRow).Select
Range(LColorCells).Interior.ColorIndex = xlNone
End Select
LRow = LRow + 1
Wend
Range("A1").Select
End Sub
and here's the code i found to loop it, but it only works on the first
worksheet.
Option Explicit
Sub LoopThroughSheets()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
'** Perform code here **
'E.g.
On Error Resume Next 'Will continue if an error results
ws.Range("A1") = ws.Name
'***********************
Next ws
End Sub
Any help would be much appreciated.
*** Sent via Developersdex http://www.developersdex.com ***