[lnkForumImage]
TotalShareware - Download Free Software
Confronta i prezzi di migliaia di prodotti.
Asp Forum
 Home | Login | Register | Search 


 

Forums >

microsoft.public.excel.programming

Colour specific cell based on 2 other cell values

bony_tony

12/12/2006 11:13:00 PM

Hi, I've got spreadsheet with a list of clients, each client having
their own row.
I have recorded a macro which goes through each client and fills in
colour on the Q column if they have a "Yes" on either column V or F.
The clients are numbered on column A (I use the last client to
determine how far down to go). The problem I have is that my macro is
a bit too slow for my liking. Any ideas on an improvement?

Dim clients As Variant
Dim distance As Variant


Range("A2").Select
Selection.End(xlDown).Select
distance = 0
clients = ActiveCell
Range("F3").Select
Do Until distance = clients
If ActiveCell = "Yes" Then
ActiveCell.Offset(0, 11).Range("A1").Select
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
ActiveCell.Offset(1, -11).Range("A1").Select
Else
ActiveCell.Offset(0, 16).Range("A1").Select
If ActiveCell = "Yes" Then
ActiveCell.Offset(0, -5).Range("A1").Select
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
ActiveCell.Offset(1, -11).Range("A1").Select
Else
ActiveCell.Offset(1, -16).Range("A1").Select
End If
End If
distance = distance + 1
Loop
End Sub
3 Answers

Don Guillett

12/12/2006 11:43:00 PM

0

This should be quick.

sub colorif()
for i= 2 to cells(rows.count,"a").end(xlup).row
if cells(i,"v")="Yes" or cells(i,"f")="Yes" then
cells(i,"v").interior.colorindex=4
cells(i,"f").interior.colorindex=4
end if
next i
end sub

--
Don Guillett
SalesAid Software
dguillett1@austin.rr.com
"bony_tony" <tony_in_oz1982@yahoo.co.uk> wrote in message
news:1165965155.500475.74820@j44g2000cwa.googlegroups.com...
> Hi, I've got spreadsheet with a list of clients, each client having
> their own row.
> I have recorded a macro which goes through each client and fills in
> colour on the Q column if they have a "Yes" on either column V or F.
> The clients are numbered on column A (I use the last client to
> determine how far down to go). The problem I have is that my macro is
> a bit too slow for my liking. Any ideas on an improvement?
>
> Dim clients As Variant
> Dim distance As Variant
>
>
> Range("A2").Select
> Selection.End(xlDown).Select
> distance = 0
> clients = ActiveCell
> Range("F3").Select
> Do Until distance = clients
> If ActiveCell = "Yes" Then
> ActiveCell.Offset(0, 11).Range("A1").Select
> With Selection.Interior
> .ColorIndex = 4
> .Pattern = xlSolid
> End With
> ActiveCell.Offset(1, -11).Range("A1").Select
> Else
> ActiveCell.Offset(0, 16).Range("A1").Select
> If ActiveCell = "Yes" Then
> ActiveCell.Offset(0, -5).Range("A1").Select
> With Selection.Interior
> .ColorIndex = 4
> .Pattern = xlSolid
> End With
> ActiveCell.Offset(1, -11).Range("A1").Select
> Else
> ActiveCell.Offset(1, -16).Range("A1").Select
> End If
> End If
> distance = distance + 1
> Loop
> End Sub
>


Martin Fishlock

12/12/2006 11:49:00 PM

0

Tony

Try this I have taken out all the selects and used a counter.

Sub clients()
Dim lLastRow As Long, lFirstRow As Long, lRow As Long

Application.ScreenUpdating = False

lLastRow = Range("A2").End(xlDown).Row
lFirstRow = 3

For lRow = lFirstRow To lLastRow
If Cells(lRow, 6) = "Yes" Or Cells(lRow, 22) = "Yes" Then
With Cells(lRow, 17).Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
End If
Next lRow

Application.ScreenUpdating = True
End Sub

--
Hope this helps
Martin Fishlock
Please do not forget to rate this reply.


"bony_tony" wrote:

> Hi, I've got spreadsheet with a list of clients, each client having
> their own row.
> I have recorded a macro which goes through each client and fills in
> colour on the Q column if they have a "Yes" on either column V or F.
> The clients are numbered on column A (I use the last client to
> determine how far down to go). The problem I have is that my macro is
> a bit too slow for my liking. Any ideas on an improvement?
>
> Dim clients As Variant
> Dim distance As Variant
>
>
> Range("A2").Select
> Selection.End(xlDown).Select
> distance = 0
> clients = ActiveCell
> Range("F3").Select
> Do Until distance = clients
> If ActiveCell = "Yes" Then
> ActiveCell.Offset(0, 11).Range("A1").Select
> With Selection.Interior
> .ColorIndex = 4
> .Pattern = xlSolid
> End With
> ActiveCell.Offset(1, -11).Range("A1").Select
> Else
> ActiveCell.Offset(0, 16).Range("A1").Select
> If ActiveCell = "Yes" Then
> ActiveCell.Offset(0, -5).Range("A1").Select
> With Selection.Interior
> .ColorIndex = 4
> .Pattern = xlSolid
> End With
> ActiveCell.Offset(1, -11).Range("A1").Select
> Else
> ActiveCell.Offset(1, -16).Range("A1").Select
> End If
> End If
> distance = distance + 1
> Loop
> End Sub
>
>

bony_tony

12/13/2006 2:24:00 AM

0

That's great, thanks for that Martin, much faster.
Once I get my head around how and what you have used there, i'm sure I
can speed up other macros
Thanks
Tony

Martin Fishlock wrote:
> Tony
>
> Try this I have taken out all the selects and used a counter.
>
> Sub clients()
> Dim lLastRow As Long, lFirstRow As Long, lRow As Long
>
> Application.ScreenUpdating = False
>
> lLastRow = Range("A2").End(xlDown).Row
> lFirstRow = 3
>
> For lRow = lFirstRow To lLastRow
> If Cells(lRow, 6) = "Yes" Or Cells(lRow, 22) = "Yes" Then
> With Cells(lRow, 17).Interior
> .ColorIndex = 4
> .Pattern = xlSolid
> End With
> End If
> Next lRow
>
> Application.ScreenUpdating = True
> End Sub
>
> --
> Hope this helps
> Martin Fishlock
> Please do not forget to rate this reply.
>
>
> "bony_tony" wrote:
>
> > Hi, I've got spreadsheet with a list of clients, each client having
> > their own row.
> > I have recorded a macro which goes through each client and fills in
> > colour on the Q column if they have a "Yes" on either column V or F.
> > The clients are numbered on column A (I use the last client to
> > determine how far down to go). The problem I have is that my macro is
> > a bit too slow for my liking. Any ideas on an improvement?
> >
> > Dim clients As Variant
> > Dim distance As Variant
> >
> >
> > Range("A2").Select
> > Selection.End(xlDown).Select
> > distance = 0
> > clients = ActiveCell
> > Range("F3").Select
> > Do Until distance = clients
> > If ActiveCell = "Yes" Then
> > ActiveCell.Offset(0, 11).Range("A1").Select
> > With Selection.Interior
> > .ColorIndex = 4
> > .Pattern = xlSolid
> > End With
> > ActiveCell.Offset(1, -11).Range("A1").Select
> > Else
> > ActiveCell.Offset(0, 16).Range("A1").Select
> > If ActiveCell = "Yes" Then
> > ActiveCell.Offset(0, -5).Range("A1").Select
> > With Selection.Interior
> > .ColorIndex = 4
> > .Pattern = xlSolid
> > End With
> > ActiveCell.Offset(1, -11).Range("A1").Select
> > Else
> > ActiveCell.Offset(1, -16).Range("A1").Select
> > End If
> > End If
> > distance = distance + 1
> > Loop
> > End Sub
> >
> >