Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Loop a code thru several worksheets
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 *** |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Loop a code thru several worksheets
Sub LoopThroughSheets()
Dim ws As Worksheet Dim sh As Worksheet Set sh = ActiveSheet Application.ScreenUpdating = False For Each ws In ActiveWorkbook.Worksheets ws.Select Call Update_Row_Colors '** 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 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 *** |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Loop a code thru several worksheets
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 *** |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
For/Next Loop through worksheets | Excel Programming | |||
Naming Worksheets - Loop within a loop issue | Excel Programming | |||
Naming Worksheets - Loop within a loop issue | Excel Programming | |||
(Complex) Loop within loop to create worksheets | Excel Programming | |||
Loop Through worksheets | Excel Programming |