Color formatting speed - Driving me loopy

K

Kidd1313

New Member
Joined
Nov 4, 2014
Messages
15
Hi Folks,

Thanks in advance for all the help you provided on the forum in getting me this far (from searching other posts). Been a long time away from VB, and just starting back.

Question:
I am using Excel 2010, and I'd like to format color of cells on my spreadsheet if they are TRUE. I currently use conditional formatting, but it limits the users ability to modify colors to their own taste, and takes me forever to update when I make a change.

Each row can have a unique color, and the color is determined by what is found on that specific row in column 2. I have come up with the attached code, and it works, but is super slow. Looking for a more efficient way to handle this style of operation. I loop through each row, find the color in column two and change color of all TRUE cells in that specific row to that color, and non-TRUE cells get changed to white. I realize I could also use a command button to just update the colors all at once, but would prefer to have it update on SelectionChange.

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim y As Long
Dim x As Long


For y = 6 To 129
    For x = 7 To 215
        If Sheet1.Cells(y, x).Value = True Then
            Sheet1.Cells(y, x).Interior.Color = Sheet1.Cells(y, 2).Interior.Color
            Sheet1.Cells(y, x).Borders.LineStyle = xlSolid
        Else
            Sheet1.Cells(y, x).Interior.Color = vbWhite
            Sheet1.Cells(y, x).Borders.LineStyle = xlNone
        End If
    Next x
Next y


End Sub

Thanks for any help you might provide!

Andy
 
Last edited:

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Sort by date Sort by votes
Try doing this, before your outer For loop:

Code: 
Application.ScreenUpdating = False

' ... code ....

Application.ScreenUpdating = True
 
Upvote 0
Instead of formatting all cells on every selection change, you could format the row that changed when the user changes or enters a value. What cell(s) does the user change that affects a row?
 
Upvote 0
iliace said:
Try doing this, before your outer For loop:

Code: 
Application.ScreenUpdating = False

' ... code ....

Application.ScreenUpdating = True
Click to expand...

Thanks for taking the time to respond.

Seems like this would stop any indication of the change happening, but would it stop the stall of the program while it's working?
 
Upvote 0
AlphaFrog said:
Instead of formatting all cells on every selection change, you could format the row that changed when the user changes or enters a value. What cell(s) does the user change that affects a row?
Click to expand...

The changes could happen on columns 2-5, and would only affect that particular row. I like where this is going. How best can you narrow the identification of the row changed? Well, I'll be looking into that anyway - thanks for taking the time to respond!
 
Upvote 0
AlphaFrog said:
Instead of formatting all cells on every selection change, you could format the row that changed when the user changes or enters a value. What cell(s) does the user change that affects a row?
Click to expand...

That's an excellent point, I didn't consider it. Perhaps limit the cells to the ones that are possibly affected. I'm assuming Sheet1 is the sheet where you have this event code, in which case you might try some logic like this:

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)


Dim rngWorkingRange As Excel.Range
Dim rng As Excel.Range


Set rngWorkingRange = Me.Range(Me.Cells(7, 6), Me.Cells(215, 129))


Set Target = Intersect(Target, rngWorkingRange)


If Target Is Nothing Then Exit Sub


Application.ScreenUpdating = False
For Each rng In Target.Cells
    With rng
        If .Value Then   ' you don't need to compare to True, if the value is a boolean
            .Interior.Color = .EntireRow.Cells(2).Interior.Color
            .Borders.LineStyle = xlSolid
        Else
            .Interior.Color = vbWhite
            .Borders.LineStyle = xlNone
        End If
    End With
Next rng
Application.ScreenUpdating = True


End Sub
 
Upvote 0
Try this...

Code: 
[color=darkblue]Private[/color] [color=darkblue]Sub[/color] Worksheet_Change([color=darkblue]ByVal[/color] Target [color=darkblue]As[/color] Range)
    [color=darkblue]Dim[/color] y [color=darkblue]As[/color] Range, x [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]If[/color] [color=darkblue]Not[/color] Intersect(Range("B:F"), Target) [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]     [color=green]'test if any cells in columns B:F have changed[/color]
        Application.ScreenUpdating = [color=darkblue]False[/color]
        [color=darkblue]For[/color] [color=darkblue]Each[/color] y [color=darkblue]In[/color] Intersect(Range("B:F"), Target).Rows     [color=green]'loop through changed cell rows[/color]
            [color=darkblue]For[/color] x = 7 [color=darkblue]To[/color] 215                                   [color=green]'loop through columns within each changed row[/color]
                [color=darkblue]With[/color] Sheet1.Cells(y.Row, x)                    [color=green]'reference cell[/color]
                    [color=darkblue]If[/color] .Value = [color=darkblue]True[/color] [color=darkblue]Then[/color]
                        .Interior.Color = Sheet1.Cells(y.Row, 2).Interior.Color
                        .Borders.LineStyle = xlSolid
                    [color=darkblue]Else[/color]
                        .Interior.Color = vbWhite
                        .Borders.LineStyle = xlNone
                    [color=darkblue]End[/color] [color=darkblue]If[/color]
                [color=darkblue]End[/color] [color=darkblue]With[/color]
            [color=darkblue]Next[/color] x
        [color=darkblue]Next[/color] y
        Application.ScreenUpdating = [color=darkblue]True[/color]
    [color=darkblue]End[/color] [color=darkblue]If[/color]
End [color=darkblue]Sub[/color]
 
Upvote 0
AlphaFrog said:
Try this...

Code: 
[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] Worksheet_Change([COLOR=darkblue]ByVal[/COLOR] Target [COLOR=darkblue]As[/COLOR] Range)
    [COLOR=darkblue]Dim[/COLOR] y [COLOR=darkblue]As[/COLOR] Range, x [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] Intersect(Range("B:F"), Target) [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]     [COLOR=green]'test if any cells in columns B:F have changed[/COLOR]
        Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
        [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] y [COLOR=darkblue]In[/COLOR] Intersect(Range("B:F"), Target).Rows     [COLOR=green]'loop through changed cell rows[/COLOR]
            [COLOR=darkblue]For[/COLOR] x = 7 [COLOR=darkblue]To[/COLOR] 215                                   [COLOR=green]'loop through columns within each changed row[/COLOR]
                [COLOR=darkblue]With[/COLOR] Sheet1.Cells(y.Row, x)                    [COLOR=green]'reference cell[/COLOR]
                    [COLOR=darkblue]If[/COLOR] .Value = [COLOR=darkblue]True[/COLOR] [COLOR=darkblue]Then[/COLOR]
                        .Interior.Color = Sheet1.Cells(y.Row, 2).Interior.Color
                        .Borders.LineStyle = xlSolid
                    [COLOR=darkblue]Else[/COLOR]
                        .Interior.Color = vbWhite
                        .Borders.LineStyle = xlNone
                    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
                [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
            [COLOR=darkblue]Next[/COLOR] x
        [COLOR=darkblue]Next[/COLOR] y
        Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
End [COLOR=darkblue]Sub[/COLOR]
Click to expand...

Works really fast - just as I hoped. Only problem left is that it does not recognize a "Fill Color" as a change, so it will not trigger the code to repaint the color in the row.
 
Upvote 0
Kidd1313 said:
Works really fast - just as I hoped. Only problem left is that it does not recognize a "Fill Color" as a change, so it will not trigger the code to repaint the color in the row.
Click to expand...

Only a manual value change triggers the Worksheet_Change event procedure. There isn't an event procedure for a format change.

It would work if the user changed the format first and values after? I don't know your methods to interact with the sheet.
 
Upvote 0
AlphaFrog said:
Only a manual value change triggers the Worksheet_Change event procedure. There isn't an event procedure for a format change.

It would work if the user changed the format first and values after? I don't know your methods to interact with the sheet.
Click to expand...

Understood - and thanks again for your input. User can change the results of the TRUEs in row by adjusting values in column C, D and E. B will require a repaint only if they change the color of the fill, which won't happen often, but could happen.

I have found that if I click (or arrow/tab) anywhere within the line I just changed fill color of column B (where I'm getting the color from), it triggers the change, but not if I click in the row above or below it....but it again fires if I click back in the row. Is it possible to track the row I just left? I just found this code elsewhere on the forum regarding an individual who was trying to set fill color of a cell based on having just left that by clicking in another cell. Not sure how I would have to modify this to make it work in my case:

http://www.mrexcel.com/forum/excel-questions/739166-format-cell-background-focus.html

Code: 
Public PreviousSelection As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not PreviousSelection Is Nothing Then PreviousSelection.Interior.ColorIndex = xlNone
  Set PreviousSelection = Target
  Target.Interior.ColorIndex = 6
End Sub

Thanks! Have a good evening!
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
395
AndyEd
A
T
  • Question
Add rows above cells containing specific string.
Replies
0
Views
166
topi1
T
A
  • Question
VBA script delete row containing specific text
Replies
1
Views
558
DanteAmor
DanteAmor
N
  • Locked
  • Question
Turn .BODY outlook email into HTMLBODY using VBA
Replies
2
Views
311
RoryA
RoryA
N
  • Question
Turn .BODY subject body in outlook into HTMLBODY using VBA
2
Replies
10
Views
598
nealmaher
N

Forum statistics

Threads
1,214,834
Messages
6,121,871
Members
449,054
Latest member
juliecooper255

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top