if end if sanity check...
would someone take a look at this and let me know if there is a
shorter method? I only want to change the color on every other row from Column A to O... I just modified a 'select every other row' code someone posted here. This works, but I thought maybe it could be cleaned up a bit. Rob |
if end if sanity check...
On Feb 5, 10:46 am, "okrob" wrote:
would someone take a look at this and let me know if there is a shorter method? I only want to change the color on every other row from Column A to O... I just modified a 'select every other row' code someone posted here. This works, but I thought maybe it could be cleaned up a bit. Rob ok, here's the code... Sub color() Dim strCol As String, rowStart As Long, rowOffset As Long Dim rg As Range Dim rng As Range Dim lastRow As Long, i As Long Dim x As Integer x = 1 For x = 1 To 15 Step 1 If x = 1 Then strCol = "A" Else If x = 2 Then strCol = "B" Else If x = 3 Then strCol = "C" Else If x = 4 Then strCol = "D" Else If x = 5 Then strCol = "E" Else If x = 6 Then strCol = "F" Else If x = 7 Then strCol = "G" Else If x = 8 Then strCol = "H" Else If x = 9 Then strCol = "I" Else If x = 10 Then strCol = "J" Else If x = 11 Then strCol = "K" Else If x = 12 Then strCol = "L" Else If x = 13 Then strCol = "M" Else If x = 14 Then strCol = "N" Else If x = 15 Then strCol = "O" 'COLUMN Else End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If rowStart = 1 'START SELECTION IN THIS ROW rowOffset = 2 'SELECT EVERY x ROW With ActiveSheet Set rg = .UsedRange.Columns(1) 'determine last row lastRow = rg.Cells(rg.Cells.Count).Row Set rg = .Range(strCol & rowStart) 'set initial range For i = rowStart + rowOffset To lastRow Step rowOffset 'loop Set rg = Application.Union(rg, .Range(strCol & i)) Next End With If rg Is Nothing Then 'no cell MsgBox "No cell" Else rg.Select End If With Selection.Interior ..ColorIndex = 35 ..Pattern = xlSolid End With Next x End Sub |
if end if sanity check...
I would suggest going to
http://www.andrewsexceltips.com and downloading andrews add ins select the columns first (A-O) Sub ColorSelectedRows() On Error Resume Next Dim c As Range, fstrw As Range, myRange As Range Dim StartRow As Long, myRowNumber As Long, Proceed As Long Dim myColor As Long, myPattern As Long, myPatternColor As Long Set myRange = Selection myRowNumber = InputBox("Enter Row Interval", "Color Alternate Rows") If Selection.Rows.count < myRowNumber Then GoTo Terminator StartRow = Selection.Item(1).Row Proceed = MsgBox("Do you want to include the first row? ", vbQuestion + vbYesNo, "Color Alternate Rows") Select Case Proceed Case vbYes For Each c In myRange If c.Row Mod myRowNumber = (StartRow + myRowNumber) Mod myRowNumber Then Set fstrw = c Exit For End If Next fstrw.Select Application.Dialogs(xlDialogPatterns).Show myColor = ActiveCell.Interior.ColorIndex myPattern = ActiveCell.Interior.Pattern myPatternColor = ActiveCell.Interior.PatternColorIndex Call SetCalcSetting For Each c In myRange If c.Row Mod myRowNumber = (StartRow + myRowNumber) Mod myRowNumber Then c.Interior.ColorIndex = myColor c.Interior.Pattern = myPattern c.Interior.PatternColorIndex = myPatternColor End If Next Case Else For Each c In myRange If c.Row Mod myRowNumber = (StartRow + myRowNumber - 1) Mod myRowNumber Then Set fstrw = c Exit For End If Next fstrw.Select Application.Dialogs(xlDialogPatterns).Show myColor = ActiveCell.Interior.ColorIndex myPattern = ActiveCell.Interior.Pattern myPatternColor = ActiveCell.Interior.PatternColorIndex Call SetCalcSetting For Each c In myRange If c.Row Mod myRowNumber = (StartRow + myRowNumber - 1) Mod myRowNumber Then c.Interior.ColorIndex = myColor c.Interior.Pattern = myPattern c.Interior.PatternColorIndex = myPatternColor End If Next End Select myRange.Select Call SetCalcSetting("Restore") Exit Sub Terminator: MsgBox "The Row Interval exceeds the rows selected! ", vbExclamation, "Color Alternate Rows" End Sub "okrob" wrote: On Feb 5, 10:46 am, "okrob" wrote: would someone take a look at this and let me know if there is a shorter method? I only want to change the color on every other row from Column A to O... I just modified a 'select every other row' code someone posted here. This works, but I thought maybe it could be cleaned up a bit. Rob ok, here's the code... Sub color() Dim strCol As String, rowStart As Long, rowOffset As Long Dim rg As Range Dim rng As Range Dim lastRow As Long, i As Long Dim x As Integer x = 1 For x = 1 To 15 Step 1 If x = 1 Then strCol = "A" Else If x = 2 Then strCol = "B" Else If x = 3 Then strCol = "C" Else If x = 4 Then strCol = "D" Else If x = 5 Then strCol = "E" Else If x = 6 Then strCol = "F" Else If x = 7 Then strCol = "G" Else If x = 8 Then strCol = "H" Else If x = 9 Then strCol = "I" Else If x = 10 Then strCol = "J" Else If x = 11 Then strCol = "K" Else If x = 12 Then strCol = "L" Else If x = 13 Then strCol = "M" Else If x = 14 Then strCol = "N" Else If x = 15 Then strCol = "O" 'COLUMN Else End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If rowStart = 1 'START SELECTION IN THIS ROW rowOffset = 2 'SELECT EVERY x ROW With ActiveSheet Set rg = .UsedRange.Columns(1) 'determine last row lastRow = rg.Cells(rg.Cells.Count).Row Set rg = .Range(strCol & rowStart) 'set initial range For i = rowStart + rowOffset To lastRow Step rowOffset 'loop Set rg = Application.Union(rg, .Range(strCol & i)) Next End With If rg Is Nothing Then 'no cell MsgBox "No cell" Else rg.Select End If With Selection.Interior ..ColorIndex = 35 ..Pattern = xlSolid End With Next x End Sub |
if end if sanity check...
Sub ColorEveryOtherRow() Dim startRow as long Dim endrow as Long Dim i as long StartRow = 5 EndRow = 47 for i = startrow to endrow step 2 cells(i,1).Resize(1,15).Interior.ColorIndex = 3 Next i End sub -- Regards, Tom Ogilvy "okrob" wrote: would someone take a look at this and let me know if there is a shorter method? I only want to change the color on every other row from Column A to O... I just modified a 'select every other row' code someone posted here. This works, but I thought maybe it could be cleaned up a bit. Rob |
if end if sanity check...
On Feb 5, 11:26 am, Tom Ogilvy
wrote: Sub ColorEveryOtherRow() Dim startRow as long Dim endrow as Long Dim i as long StartRow = 5 EndRow = 47 for i = startrow to endrow step 2 cells(i,1).Resize(1,15).Interior.ColorIndex = 3 Next i End sub -- Regards, Tom Ogilvy "okrob" wrote: would someone take a look at this and let me know if there is a shorter method? I only want to change the color on every other row from Column A to O... I just modified a 'select every other row' code someone posted here. This works, but I thought maybe it could be cleaned up a bit. Rob- Hide quoted text - - Show quoted text - Thanks Tom... Perfect as always... Rob |
if end if sanity check...
On Feb 5, 11:26 am, Tom Ogilvy
wrote: Sub ColorEveryOtherRow() Dim startRow as long Dim endrow as Long Dim i as long StartRow = 5 EndRow = 47 for i = startrow to endrow step 2 cells(i,1).Resize(1,15).Interior.ColorIndex = 3 Next i End sub -- Regards, Tom Ogilvy "okrob" wrote: would someone take a look at this and let me know if there is a shorter method? I only want to change the color on every other row from Column A to O... I just modified a 'select every other row' code someone posted here. This works, but I thought maybe it could be cleaned up a bit. Rob- Hide quoted text - - Show quoted text - My final code for those interested... Rob Sub color_rows() Dim startRow As Long Dim endrow As Long Dim i As Long startRow = 1 endrow = ActiveSheet.UsedRange.Cells(ActiveSheet.UsedRange. Cells.Count).Row For i = startRow To endrow Step 2 Cells(i, 1).Resize(1, 15).Interior.ColorIndex = 35 Next i End Sub |
All times are GMT +1. The time now is 08:32 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com