ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   if end if sanity check... (https://www.excelbanter.com/excel-programming/382606-if-end-if-sanity-check.html)

okrob

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


okrob

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


ufo_pilot

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



Tom Ogilvy

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



okrob

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


okrob

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