Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Multiple users on workbook, but no shared drive, how to maintain sanity? | Excel Discussion (Misc queries) | |||
Check if Conditional Format is True or False / Check cell Color | Excel Worksheet Functions | |||
Filtering in a view (sanity check) | New Users to Excel | |||
splitting names can't see whats going wrong (Save My Sanity ) | Excel Worksheet Functions | |||
splitting names can't see whats going wrong (Save My Sanity ) | Excel Worksheet Functions |