Set StartCell as ActiveCell

[ekw590]

The following Macro sets the StartCell as $A4 but that is not always the case so I'd like to set it as the ActiveCell. JUst not sure how to do that. I appreciate any help anyone can offer me. Thanks EVan



[VBA]
Sub FormatCellFill()
Dim R As Range
Dim LastRow As Long
Dim ColorIndex As Long
Dim InFill As Boolean
Dim N As Long
Dim ColorWidthColumns As Long
Dim StartCell As String
Dim DataTestColumn As String

ColorIndex = 20 'light blue '<<<<<< Set color index
InFill = True '<<<<< True -> Color first group, False-> No color first group
ColorWidthColumns = 12 '<<<< how many columns wide to format
StartCell = "$A4” '<<<< where to start the banding
DataTestRow = “ ” '<<<< column number containing data to test
Set R = Range(StartCell)
With R.Worksheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
N = 0
Do Until R.Row > LastRow
N = N + 1
If R.EntireRow.Cells(1, 4).Value <> vbNullString Then
If InFill = True Then
R.EntireRow.Cells(1, "A").Resize(, ColorWidthColumns).Interior.ColorIndex = ColorIndex
Else
R.EntireRow.Cells(1, "A").Resize(, ColorWidthColumns).Interior.ColorIndex = xlColorIndexNone
End If
Else
N = 0
InFill = True
End If
If N >= 30 Then
N = 0
InFill = Not InFill
End If
· Set R = R(2, 1)
· Loop
· End Sub
[/VBA]Change the lines marked with '<<<< to the appropriate values.

[Simon Lloyd]

Just use:
[VBA]StartCell = Activecell.Address[/VBA]

[gcomyn]

well... if the variable "StartCell" is only used to determine where to start, you can change the following line:

[vba]
Set R = Range(StartCell)
[/vba]

to

[vba]
Set R = ActiveCell
[/vba]

Then you can remove the StartCell variable completely... unless you are going to use it in code that is not here yet.


I tested in on a sheet that I have, and it works, from what I understand of the code.

GComyn

[ekw590]

Thanks -- works great.

[ekw590]

Is it possible to add a 2nd color to this Macro?

[gcomyn]

if you made colorindex an array, then either parse through the array, or make it random, that should work... this is just a quick thought, so I don't have any code for you.

GComyn

[gcomyn]

the following will give you random colors for each correct row:

[vba]
Sub FormatCellFill()
Dim R As Range
Dim LastRow As Long
Dim ColorIndex(1 To 20) As Long
Dim InFill As Boolean
Dim N As Long
Dim ColorWidthColumns As Long
Dim x As Integer


For x = 1 To 20 Step 1
ColorIndex(x) = x + 19
Next

InFill = True '<<<<< True -> Color first group, False-> No color first group
ColorWidthColumns = 12 '<<<< how many columns wide to format
Set R = ActiveCell
With R.Worksheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
N = 0
Do Until R.Row > LastRow
N = N + 1
If R.EntireRow.Cells(1, 4).Value <> vbNullString Then
If InFill = True Then
R.EntireRow.Cells(1, "A").Resize(, ColorWidthColumns).Interior.ColorIndex = ColorIndex(Rnd(20) * 20)
Else
R.EntireRow.Cells(1, "A").Resize(, ColorWidthColumns).Interior.ColorIndex = xlColorIndexNone
End If
Else
N = 0
InFill = True
End If
If N >= 30 Then
N = 0
InFill = Not InFill
End If
Set R = R(2, 1)
Loop
End Sub
[/vba]

To set specific colors for specific values, in the section :

[vba]
If InFill = True Then
If IsNumeric(R.EntireRow.Cells(1, 4).Value) Then
R.EntireRow.Cells(1, "A").Resize(, ColorWidthColumns).Interior.ColorIndex = ColorIndex(1)
Else
R.EntireRow.Cells(1, "A").Resize(, ColorWidthColumns).Interior.ColorIndex = ColorIndex(5)
End If

Else
[/vba]

put either a select case, or nested if's... checking to see what the value is, then putting the color you want.

GComyn

[gcomyn]

after more checking.... I noticed that if the cell that is being checked (R.EntireRow.Cells(1, 4).Value) is emptied, and the row is colored, then the color stays, even during the next run of the code, because it doesn't get changed back... also, the only thing I can see for the variable N is that every 30 rows, it changes infill... [edit] ahhh I see now... if there are more than 30 continuous "colored" rows, then it turns it off, then back on after another 30 continuous.... not a bad idea.

anyway, I've copied the xlColorIndexNone line to after the else and just before the N=0 line for that if/then statement, so that if the cell somehow get's emptied, the color will be removed.... here is the code:

[vba]
Sub FormatCellFill()
Dim R As Range
Dim LastRow As Long
Dim ColorIndex(1 To 20) As Long
Dim InFill As Boolean
Dim N As Long
Dim ColorWidthColumns As Long
Dim x As Integer


For x = 1 To 20 Step 1
ColorIndex(x) = x + 19
Next

InFill = True '<<<<< True -> Color first group, False-> No color first group
ColorWidthColumns = 12 '<<<< how many columns wide to format
Set R = ActiveCell
With R.Worksheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
N = 0
Do Until R.Row > LastRow
N = N + 1
If R.EntireRow.Cells(1, 4).Value <> vbNullString Then
If InFill = True Then
If IsNumeric(R.EntireRow.Cells(1, 4).Value) Then
R.EntireRow.Cells(1, "A").Resize(, ColorWidthColumns).Interior.ColorIndex = ColorIndex(1)
Else
R.EntireRow.Cells(1, "A").Resize(, ColorWidthColumns).Interior.ColorIndex = ColorIndex(5)
End If
Else
R.EntireRow.Cells(1, "A").Resize(, ColorWidthColumns).Interior.ColorIndex = xlColorIndexNone
End If
Else
R.EntireRow.Cells(1, "A").Resize(, ColorWidthColumns).Interior.ColorIndex = xlColorIndexNone
N = 0
InFill = True
End If
If N >= 30 Then
N = 0
InFill = Not InFill
End If
Set R = R(2, 1)
Loop
End Sub
[/vba]

Gcomyn

[ekw590]

Re the code to set random colors: I get Run-time error '9' subscript out of range with this line of code: R.EntireRow.Cells(1, "A").Resize(, ColorWidthColumns).Interior.ColorIndex = ColorIndex(Rnd(20) * 20)
I changed it to ColorIndex(Rnd(1-20) * 20) that gives me color(37) only
I changed it to ColorIndex(Rnd(1-20) * 1) that gives me color(20) only

[ekw590]

Re: the code to set the color:
R.EntireRow.Cells(1, "A").Resize(, ColorWidthColumns).Interior.ColorIndex = ColorIndex(1)
Else
R.EntireRow.Cells(1, "A").Resize(, ColorWidthColumns).Interior.ColorIndex = ColorIndex(5)
End If
I don't get either of these colors instead I get only 1: ColorIndex(13)

[gcomyn]

the colorindex is an array... and you should get colors 20 through 40... I don't know how you are not getting them.