Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 142
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 142
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 142
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 6,953
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 142
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 142
Default 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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Multiple users on workbook, but no shared drive, how to maintain sanity? [email protected] Excel Discussion (Misc queries) 1 October 2nd 07 12:32 AM
Check if Conditional Format is True or False / Check cell Color Kevin McCartney Excel Worksheet Functions 5 June 29th 07 11:12 AM
Filtering in a view (sanity check) ICTag New Users to Excel 1 June 14th 06 12:01 AM
splitting names can't see whats going wrong (Save My Sanity ) workaholic Excel Worksheet Functions 5 November 8th 05 04:19 PM
splitting names can't see whats going wrong (Save My Sanity ) workaholic Excel Worksheet Functions 1 November 8th 05 02:09 AM


All times are GMT +1. The time now is 10:17 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"