PDA

View Full Version : Set StartCell as ActiveCell



ekw590
07-21-2010, 12:15 PM
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




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
Change the lines marked with '<<<< to the appropriate values.

Simon Lloyd
07-21-2010, 12:27 PM
Just use:
StartCell = Activecell.Address

gcomyn
07-21-2010, 12:27 PM
well... if the variable "StartCell" is only used to determine where to start, you can change the following line:


Set R = Range(StartCell)


to


Set R = ActiveCell


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
:sleuth:

ekw590
07-21-2010, 01:05 PM
Thanks -- works great.

ekw590
07-21-2010, 02:09 PM
Is it possible to add a 2nd color to this Macro?

gcomyn
07-21-2010, 02:33 PM
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
:sleuth:

gcomyn
07-21-2010, 02:44 PM
the following will give you random colors for each correct row:


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


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


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


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

GComyn
:sleuth:

gcomyn
07-21-2010, 02:58 PM
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:


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


Gcomyn
:sleuth:

ekw590
08-03-2010, 09:42 AM
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
08-03-2010, 10:08 AM
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
08-03-2010, 10:09 AM
the colorindex is an array... and you should get colors 20 through 40... I don't know how you are not getting them.