PC Review


Reply
Thread Tools Rate Thread

Colour specific cell based on 2 other cell values

 
 
bony_tony
Guest
Posts: n/a
 
      12th Dec 2006
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

 
Reply With Quote
 
 
 
 
Don Guillett
Guest
Posts: n/a
 
      12th Dec 2006
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
(E-Mail Removed)
"bony_tony" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> 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
>



 
Reply With Quote
 
bony_tony
Guest
Posts: n/a
 
      13th Dec 2006
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
> >
> >


 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

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


Similar Threads
Thread Thread Starter Forum Replies Last Post
Change 3rd cell colour based on cell 1 >= cell2 in range wombarrapete Microsoft Excel Discussion 8 21st Dec 2008 09:41 PM
Default colour in cell based on specific entry =?Utf-8?B?S0NH?= Microsoft Excel Worksheet Functions 4 5th Aug 2007 09:26 AM
Advanced Conditional Formatting Help Required - Change cell colour based on values of other cells gregglazar@gmail.com Microsoft Excel Programming 1 9th Feb 2007 12:24 AM
change current cell colour based on the value of adjacent cell on other worksheet Rits Microsoft Excel Programming 2 23rd Nov 2006 11:57 AM
Conditional Format with VBA - Interior Colour of cell based on value from in-cell dropdown Steve Microsoft Excel Programming 5 15th Jun 2004 11:45 AM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 04:30 PM.