PDA

View Full Version : Solved: Excel 2003 - Highlighted row using top & bottom borders. Would like to speed up code



frank_m
12-15-2010, 02:16 AM
I wrote this code in my selection change event to highlight the selected row using top and bottom borders. It works well except that with 15,000 rows it's a little slower than I would like, taking about 2 seconds for each selection change.

Any ideas on how it can be coded to run faster?

I've attached a sample workbook.

Thanks

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim LastRow As Long

ActiveSheet.DisplayAutomaticPageBreaks = False

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False

With Range("A1:Q" & LastRow - 1)

.Borders(xlEdgeTop).LineStyle = xlNone

.Borders(xlEdgeBottom).LineStyle = xlNone

.Borders(xlInsideHorizontal).LineStyle = xlNone

End With

If ActiveCell.Row > 15 Then

If Selection.Rows.Count = 1 And Selection.Row < LastRow Then

With ActiveSheet.Range(Cells(ActiveCell.Row, 1), _
Cells(ActiveCell.Row, 17)).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With

With ActiveSheet.Range(Cells(ActiveCell.Row, 1), _
Cells(ActiveCell.Row, 17)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With

End If

End If

Range("A15:Q15").Interior.ColorIndex = 15

Cells(15, ActiveCell.Column).Interior.ColorIndex = 45

Application.ScreenUpdating = True

End Sub

p45cal
12-15-2010, 02:48 AM
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static TheRow
Application.ScreenUpdating = False
Dim LastRow As Long
'ActiveSheet.DisplayAutomaticPageBreaks = False 'in a sheet activate event instead?
LastRow = Range("A" & Rows.Count).End(xlUp).Row
With TheRow
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
'.Borders(xlInsideHorizontal).LineStyle = xlNone 'needed?
End With
If ActiveCell.Row > 15 Then
If Target.Rows.Count = 1 And Target.Row < LastRow Then
Set TheRow = Target.EntireRow.Resize(, 17)
With TheRow.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With
With TheRow.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With
End If
End If
Range("A15:Q15").Interior.ColorIndex = 15
Cells(15, ActiveCell.Column).Interior.ColorIndex = 45
Application.ScreenUpdating = True
End Sub
It will also tidy things up to add another event, say workbook_open or sheet_activate, to remove highlighting left over from when the workbook is saved as TheRow will be forgotten/not exist when the workbook is first opened.

frank_m
12-15-2010, 03:08 AM
Thanks for the help

Unfortunately when I try to run your code I get a runtime error 424 Object required with this line highlighted yellow .Borders(xlEdgeTop).LineStyle = xlNone

I've attached a sample workbook to demonstrate the error.

p45cal
12-15-2010, 03:23 AM
Oh yes.., need to check TheRow exists on first run:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static TheRow As Range
Application.ScreenUpdating = False
Dim LastRow As Long
'ActiveSheet.DisplayAutomaticPageBreaks = False 'in a sheet activate event instead?
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
If Not TheRow Is Nothing Then
With TheRow
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
'.Borders(xlInsideHorizontal).LineStyle = xlNone 'needed?
End With
End If
If ActiveCell.Row > 15 Then
If Target.Rows.Count = 1 And Target.Row < LastRow Then
Set TheRow = Target.EntireRow.Resize(, 17)
With TheRow.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With
With TheRow.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With
End If
End If
Range("A15:Q15").Interior.ColorIndex = 15
Cells(15, ActiveCell.Column).Interior.ColorIndex = 45
Application.ScreenUpdating = True
End Sub
or killing two birds with one stone, so you don't have to have to worry about TheRow being forgotten between saving and opening the workbook:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static TheRow As Range
Application.ScreenUpdating = False
Dim LastRow As Long
'ActiveSheet.DisplayAutomaticPageBreaks = False 'in a sheet activate event instead?
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
If TheRow Is Nothing Then Set TheRow = Range("A1:Q" & LastRow - 1)
With TheRow
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
'.Borders(xlInsideHorizontal).LineStyle = xlNone 'needed?
End With
If ActiveCell.Row > 15 Then
If Target.Rows.Count = 1 And Target.Row < LastRow Then
Set TheRow = Target.EntireRow.Resize(, 17)
With TheRow.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With
With TheRow.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With
End If
End If
Range("A15:Q15").Interior.ColorIndex = 15
Cells(15, ActiveCell.Column).Interior.ColorIndex = 45
Application.ScreenUpdating = True
End Sub

frank_m
12-15-2010, 03:55 AM
Thanks a bunch. That works great. And is super fast being that only the target row has to be dealt with. I would have never worked that out on my own.

The best that I could come up with as far as highlighting the previously select row and selecting the same cell when the workbook is closed and re-opened, was by using the Before Close and Before Open events as shown below. I'm sure it can be more elegantly coded, but it's fast and seems to be working fine.

I've attached a sample workbook with all of the code.

Thanks so much for sharing your time and skill, as your method is so, so much faster. :bow:
Private Sub Workbook_BeforeClose(Cancel As Boolean)

Application.ScreenUpdating = False

ThisWorkbook.Sheets("Sheet1").Select

With ActiveCell.EntireRow.Resize(, 17)

.Borders(xlEdgeTop).LineStyle = xlNone

.Borders(xlEdgeBottom).LineStyle = xlNone

End With

Application.ScreenUpdating = True

End Sub

Private Sub Workbook_Open()

Dim MyRangeAddress As String

MyRangeAddress = ActiveCell.Address

ActiveCell.EntireRow.Resize(, 17).Select

Range(MyRangeAddress).Select

End Sub

p45cal
12-15-2010, 03:58 AM
I should test thoroughly before I post,try (slow only for the first selection change after opening the workbook):

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static TheRow As Range
Application.ScreenUpdating = False
Dim LastRow As Long
'ActiveSheet.DisplayAutomaticPageBreaks = False 'in a sheet activate event instead?
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
If TheRow Is Nothing Then
With Range("A1:Q" & LastRow - 1)
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone 'yes needed here
End With
Else
With TheRow
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
'.Borders(xlInsideHorizontal).LineStyle = xlNone 'needed? No
End With
End If
If ActiveCell.Row > 15 Then
If Target.Rows.Count = 1 And Target.Row < LastRow Then
Set TheRow = Target.EntireRow.Resize(, 17)
With TheRow.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With
With TheRow.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With
End If
End If
Range("A15:Q15").Interior.ColorIndex = 15
Cells(15, ActiveCell.Column).Interior.ColorIndex = 45
Application.ScreenUpdating = True
End Sub

frank_m
12-15-2010, 04:13 AM
Well, that works, and being slow only with the first selection is not an issue, but your previous code along with the open and close events that I coded is fast with the first and every selection. Plus my code does allow your code to add the row borders to the previously selected row and select the same cell that was selected when the workbook was closed.

The 1 to 1 1/2 second saving's may possibly being traded off for a slower opening and closing time, but I'm not noticing it.

If you have time try out the sample workbook in my last post, to see what you think.

Thanks

p45cal
12-15-2010, 05:37 AM
Rather than in a before_close event, it might be better in a before_save event. Why?
1. The close event takes place after the save event, so your changes may not be saved.
2. If someone saves the workbook then closes it they get asked AGAIN, if they want to save it. Usually, since they may have already just saved it they may choose No.

Users usually expect, on opening a workbook to be on the same sheet and cell(s) as when they closed it. This may not happen with these open and close event handlers. (A sheet gets selected on open and since you've stored the activecell address rather than the selection, if the user has left a block of cells selected on sheet1, he'll find that only one cell is selected on reopening.

I prefer all code related to something to be in one place.

There'll be no noticeable speed cost to getting up and running from opening the workbook, and likewise while using the sheet, with my last suggestion in msg #6 and removing the open and close events.

frank_m
12-15-2010, 01:11 PM
Thanks for your explanations about the before close event verses the before save event. It will come in handy being aware of those facts indeed.

And I have discovered that your latest version of code truly is the best solution under a variety of scenarios I tested.

I'm a happy camper now :cloud9: Thanks so much for your time.

frank_m
02-13-2011, 10:11 AM
I've attached a sample workbook. Can anyone spot why a right side red border is being added to column k of the selected row when I have Column's M thru L hidden and a filter applied? :doh:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static TheRow As Range
Application.ScreenUpdating = False
Dim Lastrow As Long

Lastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
If TheRow Is Nothing Then
With Range("A1:Q" & Lastrow - 1)
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
Else
With TheRow
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
End With
End If
If ActiveCell.Row > 15 Then
If Target.Rows.Count = 1 And Target.Row < Lastrow Then
Set TheRow = Target.EntireRow.Resize(, 17)
With TheRow.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With
With TheRow.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With
End If
End If
Range("A15:Q15").Interior.ColorIndex = 15
Cells(15, ActiveCell.Column).Interior.ColorIndex = 45
Application.ScreenUpdating = True
End Sub

frank_m
02-14-2011, 08:24 AM
I've been trying to see if I can solve my problem by coloring only the borders of the visible cells, but the way that I have attempted that is causing me problems. I get an Application, or Object Defined Error with the command Set TheRow = Target.EntireRow.Resize(, 17)
But if I unhide the columns it works fine.
If I change the resize to 15, the error is avoided but the loop struggle's taking about 7 seconds and ofcourse the coloring is not done for the last two columns.

Any help will be much appreciated

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static TheRow As Range
Dim Lastrow As Long
Static aCell As Range
Lastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False

If TheRow Is Nothing Then
With Range("A1:Q" & Lastrow)
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
Else
With TheRow
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
End With
End If
If ActiveCell.Row > 15 Then
If Target.Rows.Count = 1 And Target.Row < Lastrow Then
'On Error Resume Next
Set TheRow = Target.EntireRow.Resize(, 17)
'On Error GoTo 0
Set TheRow = TheRow.SpecialCells(xlVisible)

If Not TheRow Is Nothing Then
For Each aCell In TheRow
With aCell.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With
With aCell.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With
Next
End If
End If
End If
Range("A15:Q15").Interior.ColorIndex = 15
Cells(15, ActiveCell.Column).Interior.ColorIndex = 45
Application.ScreenUpdating = True
End Sub

p45cal
02-14-2011, 11:22 AM
I couldn't reproduce the "right side red border is being added to column k ", however I did see a problem with the row borders highlight not being removed from cells in columns which were hidden when the autofilter was active. I liked your idea of highlighting one cell at a time to try to circumvent the problem, which I've used below - it works ok here, try it on your system. It might be good enough for your purposes.
The line setting therow to specialcells(xlvisible) seems to fire the selection_change event - loopwise so it iterates 'til it's sick of it (the several seconds delay), so I haven't used it.
We're having to circumvent some slightly buggy Excel behaviour here.
The reason you got the object defined error was because target had become two areas (the result of previously setting therow to specialcells(xlvisible)) which then fired another selection_change event, so it didn't like using .EntireRow with two non-contiguous ranges (even if they are on the same row!).

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static TheRow As Range
Application.ScreenUpdating = False
Dim Lastrow As Long
Dim cll as Range
Lastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
If TheRow Is Nothing Then
With Range("A1:Q" & Lastrow - 1)
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
Else
For Each cll In TheRow.Cells
cll.Borders(xlEdgeTop).LineStyle = xlNone
cll.Borders(xlEdgeBottom).LineStyle = xlNone
Next cll
End If
If ActiveCell.Row > 15 Then
If Target.Rows.Count = 1 And Target.Row < Lastrow Then
Set TheRow = Target.EntireRow.Resize(, 17)
With TheRow.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With
With TheRow.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With
End If
End If
Range("A15:Q15").Interior.ColorIndex = 15
Cells(15, ActiveCell.Column).Interior.ColorIndex = 45
Application.ScreenUpdating = True
End Sub

frank_m
02-14-2011, 11:52 AM
Thanks, I appreciate that a lot. Your new version works very well. I had also noticed segments of the borders not being removed properly after releasing the filter. I had been using a clunky work around for that, but your new code takes care of it much more efficiently.

As far as the right side red border, I'm still getting that, I just tried it with excel 2003 and that's not happening. So apparently it's some sort of bug when running an .xls file in 2007

I'm using the work around of adding the command shown below in bold (inserted right before the last End if)
With TheRow.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With
End If
'Next Line removes Col K right side border that mysteriously is being added in Excel 2007, on my machine
ActiveCell.Offset(0, 11 - ActiveCell.Column).Borders(xlEdgeRight).LineStyle = xlNone
End If

Range("A15:Q15").Interior.ColorIndex = 15
Cells(15, ActiveCell.Column).Interior.ColorIndex = 45
Application.ScreenUpdating = True
End Sub
Thanks again

p45cal
02-15-2011, 10:04 AM
That line in bold is a bit convoluted, try instead, in nearly the same place: With TheRow.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With
TheRow.Cells(11).Borders(xlEdgeRight).LineStyle = xlNone
End If
End If

frank_m
02-19-2011, 01:40 AM
For some reason when I moved this to my actual workbook (that has other procedures that also run during the Selection Change Event)
I had to change the following command
Set TheRow = Target.EntireRow.Resize(, 30) to:
Set TheRow = Target.EntireRow.Resize(1, 30) Without that change the code exits before coloring the borders.
I put a msgbox right before the border coloring segment, to see if the code gets that far, and it does not.

With the change it seems to work fine

frank_m
02-19-2011, 02:57 AM
Well, that fix did not last.

But I did figure out what was causing it.

It was due to an inefficient conditional formatting that I'm using in Column B
Once I improved the 2nd condition formula I was using, this is problem went away.
see: http://www.vbaexpress.com/forum/showthread.php?p=236412#post236412

By the way, I forgot to thankyou p45cal for that last code improvement. It works well and is certainly much cleaner than what I came up with :yes

frank_m
02-19-2011, 08:40 AM
Edit: woops I meant to post this at my other thread. -- However it is relevant here also, so I decided to leave it.

As I was working away at stripping code and data and many of the sheets out of the workbook to reduce it's size so that I could post a sample, I stumbled across what was causing the issue.

Here is how the code was:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

Static TheRow As Range
Dim cll As Range
Dim Lastrow As Long

Lastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

If ActiveCell.Row > 15 Then

ActiveSheet.Unprotect

Cells(10, 1).Value = Target.EntireRow.Cells(1).Value
Cells(10, 2).Value = Target.EntireRow.Cells(2).Value
Cells(10, 3).Value = Target.EntireRow.Cells(3).Value
Cells(10, 4).Value = Target.EntireRow.Cells(4).Value
Cells(10, 5).Value = Target.EntireRow.Cells(5).Value

Cells(10, 6).Value = Target.EntireRow.Cells(6).Value
Cells(10, 7).Value = Target.EntireRow.Cells(7).Value
Cells(10, 8).Value = Target.EntireRow.Cells(8).Value
Cells(10, 9).Value = Target.EntireRow.Cells(9).Value
Cells(10, 10).Value = Target.EntireRow.Cells(10).Value
Cells(10, 11).Value = Target.EntireRow.Cells(11).Value
Cells(10, 12).Value = Target.EntireRow.Cells(12).Value
Cells(10, 13).Value = Target.EntireRow.Cells(13).Value
Cells(10, 14).Value = Target.EntireRow.Cells(14).Value
Cells(10, 15).Value = Target.EntireRow.Cells(15).Value
Cells(10, 16).Value = Target.EntireRow.Cells(16).Value
Cells(10, 17).Value = Target.EntireRow.Cells(17).Value
Cells(10, 18).Value = Target.EntireRow.Cells(18).Value
Cells(10, 19).Value = Target.EntireRow.Cells(19).Value
Cells(10, 20).Value = Target.EntireRow.Cells(20).Value
Cells(10, 21).Value = Target.EntireRow.Cells(21).Value
Cells(10, 22).Value = Target.EntireRow.Cells(22).Value
Cells(10, 23).Value = Target.EntireRow.Cells(23).Value


If TheRow Is Nothing Then
With Range("A16:AD" & Lastrow)
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
Else
For Each cll In TheRow.Cells
cll.Borders(xlEdgeTop).LineStyle = xlNone
cll.Borders(xlEdgeBottom).LineStyle = xlNone
Next cll
End If


If ActiveCell.Row > 15 Then

If Target.Rows.Count = 1 Then

Application.ScreenUpdating = False

Set TheRow = Target.EntireRow.Resize(, 30)

With TheRow.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With

With TheRow.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With

TheRow.Cells(14).Borders(xlEdgeRight).LineStyle = xlNone
End If
End If

Range("A15:AD15").Interior.ColorIndex = 15
Cells(15, Target.Column).Interior.ColorIndex = 45
Application.ScreenUpdating = True

End If

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True, userinterfaceonly:=True

End Sub In the version below you can see that I moved Application.ScreenUpdating = False farther up in the code.
I understand why it's much better there, but it makes no sense to me why the events only fire slowly when conditional formatting is used

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

Static TheRow As Range
Dim cll As Range
Dim Lastrow As Long

Lastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

If ActiveCell.Row > 15 Then

Application.ScreenUpdating = False

ActiveSheet.Unprotect

Cells(10, 1).Value = Target.EntireRow.Cells(1).Value
Cells(10, 2).Value = Target.EntireRow.Cells(2).Value
Cells(10, 3).Value = Target.EntireRow.Cells(3).Value
Cells(10, 4).Value = Target.EntireRow.Cells(4).Value
Cells(10, 5).Value = Target.EntireRow.Cells(5).Value

Cells(10, 6).Value = Target.EntireRow.Cells(6).Value
Cells(10, 7).Value = Target.EntireRow.Cells(7).Value
Cells(10, 8).Value = Target.EntireRow.Cells(8).Value
Cells(10, 9).Value = Target.EntireRow.Cells(9).Value
Cells(10, 10).Value = Target.EntireRow.Cells(10).Value
Cells(10, 11).Value = Target.EntireRow.Cells(11).Value
Cells(10, 12).Value = Target.EntireRow.Cells(12).Value
Cells(10, 13).Value = Target.EntireRow.Cells(13).Value
Cells(10, 14).Value = Target.EntireRow.Cells(14).Value
Cells(10, 15).Value = Target.EntireRow.Cells(15).Value
Cells(10, 16).Value = Target.EntireRow.Cells(16).Value
Cells(10, 17).Value = Target.EntireRow.Cells(17).Value
Cells(10, 18).Value = Target.EntireRow.Cells(18).Value
Cells(10, 19).Value = Target.EntireRow.Cells(19).Value
Cells(10, 20).Value = Target.EntireRow.Cells(20).Value
Cells(10, 21).Value = Target.EntireRow.Cells(21).Value
Cells(10, 22).Value = Target.EntireRow.Cells(22).Value
Cells(10, 23).Value = Target.EntireRow.Cells(23).Value


If TheRow Is Nothing Then
With Range("A16:AD" & Lastrow)
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
Else
For Each cll In TheRow.Cells
cll.Borders(xlEdgeTop).LineStyle = xlNone
cll.Borders(xlEdgeBottom).LineStyle = xlNone
Next cll
End If


If ActiveCell.Row > 15 Then

If Target.Rows.Count = 1 Then

Set TheRow = Target.EntireRow.Resize(, 30)

With TheRow.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With

With TheRow.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With

TheRow.Cells(14).Borders(xlEdgeRight).LineStyle = xlNone
End If
End If

Range("A15:AD15").Interior.ColorIndex = 15
Cells(15, Target.Column).Interior.ColorIndex = 45
Application.ScreenUpdating = True

End If

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True, userinterfaceonly:=True

End Sub
To make sure that I've explained correctly, ONLY with the 2nd version of code shown above, I now am able to use conditional formatting without it affecting my selection event code

If you'd like I can finish up with the stripping down the workbook, so you'll be able to see for yourself.

Thanks

p45cal
02-19-2011, 09:16 AM
Do you also have a Worksheet_Change event in the sheet's code module or a Workbook_SheetChange event in the ThisWorkbook's code module?
If so, then each time the macro changes the sheet, it will trigger another event. This can get into huge numbers of nested events.
Your code makes lots of changes in:
Cells(10, 1).Value = Target.EntireRow.Cells(1).Value
Cells(10, 2).Value = Target.EntireRow.Cells(2).Value
Cells(10, 3).Value = Target.EntireRow.Cells(3).Value


etc. which (untested) should be possible in one line:
Range("A10:W10").Value = Target.EntireRow.Cells(1).Resize(23).Value
But try temporarily disabling events with:
Application.EnableEvents = False at the beginning and a
Application.EnableEvents = True at the end.
If this speeds it up then we can insert some slicker code to prevent (briefly) events from triggering while the macro is working.

ps. If you break and reset the code while EnableEvents is set to false, you will have manually to reset it to true in the immediate pane in order for the events to trigger once again.

frank_m
02-19-2011, 10:11 AM
HI p45cal,

May I ask your name by the way?

I removed all change event code and that made no difference.

I also tried the disabling events at the beginning and enabling at the end, that also didn't help.

I need to rest soon, but I will try the other things you suggested later today.

As I tried to describe before, moving Application.ScreenUpdating = False to near the beginning of the code, did iliminate my problem

I'm posting two sample workbook's so you can see the one that is named FAST is attached in this post

The 2nd workbook that is SLOW, I have to start a new post in order to be able to upload that one.

frank_m
02-19-2011, 10:18 AM
Here is the version where I have the screen updating set to false too far down in the code, causing it to run slow.

The main thing that perplexes me is how the conditional formatting effects that. -- If I removed the conditional formation, this same slow workbook will run fast. :doh:

Edit: see page 2 in this thread to download another sample where I removed the conditional formatting, which enables the selection change event code to run fast even though the screen updating is not located where it should be.

frank_m
02-19-2011, 10:24 AM
The workbook attached here is the same workbook that was slow. All I did was remove the conditional formatting, now it runs FAST :doh:

Also see my other two sample workbooks in my previous two posts on page one of this thread. One is slow, the other is fast by turning off screen updating sooner (that part of all this does make sense to me)

p45cal
02-19-2011, 01:20 PM
Yes, the siting of Application.screenupdating seems to solve your problem.
I made a mess of my proposed line, it updated cells in a column rather than in a row, this is the correct version (with a comma added):
Range("A10:W10").Value = Target.EntireRow.Cells(1).Resize(, 23).Value
Pascal

frank_m
02-19-2011, 04:25 PM
Hi Pascal,

Your 'one liner' works a treat :thumb It's of course faster, (not much faster, but it is noticeable, plus it sure saves a lot of typing.)

* Thanks a lot :friends:

Edit: I just experimented more and discovered that with your code, and when I have rows filtered, and I have conditional formatting in column B, now there is only a slight slow down (maybe a 1/2 a second extra delay, whereas before using your 'one liner' the delay was 3 to 4 seconds)