Conditional Forma

B

Beamer

New Member
Joined
Mar 17, 2004
Messages
16
Hi all, hope someone can help me with next problem ; I have a template sheet that I use to import data. Once the data is processed and cleaned, it is past to a new clean sheet without VBA code (apart from Conditional format). This is where the problem starts. I am copying and pasting complete sheets, with values only, and need as you can see below 5 criteria for conditional formatting.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim icolor As Integer
If Not Intersect(Target, Range("C1:C500")) Is Nothing Then
Select Case Target
Case "Degd Sv."
icolor = 6
Case "short Sv dis."
icolor = 12
Case "Sv Dis>5min"
icolor = 7
Case "long Sv dis"
icolor = 53

Case Else
icolor = 0

End Select
Target.Interior.ColorIndex = icolor
End If

End Sub

Porblem is that this does not work whith copying data and that I als get a RUNTIME ERROR 13 / Type mismatch.
Who of you guru's out there can help me ?

Thanks
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Sort by date Sort by votes
You're getting an error because the changed range (ie the Target parameter) when you're pasting is multiple cells rather than just one. This should circumvent the problem, but bear in mind that you're going to get a long delay if you're copying and pasting or deleting a lot of cells-

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("C1:C500")) Is Nothing Then Call ChangeColour(Target)

End Sub

Public Sub ChangeColour(rng As Range)
Dim c As Range
Dim iColor As Integer

Application.ScreenUpdating = False
For Each c In rng
    Select Case c.Value
    Case "Degd Sv."
        iColor = 6
    Case "short Sv dis."
        iColor = 12
    Case "Sv Dis>5min"
        iColor = 7
    Case "long Sv dis"
        iColor = 53
    Case Else
        iColor = xlColorIndexNone
    End Select
    c.Interior.ColorIndex = iColor
Next c
Application.ScreenUpdating = True

End Sub
 
Upvote 0
Mudface, thanks for your suggestion. I tried the code , but it hangs up excel when I activate it.
The workbook is not totally opened and excel hangs with 98 CPU load.

Any other suggestions ?
 
Upvote 0
In retrospect, it might be better simply to run a routine following your paste rather than using a Change event. Looking at the routine I posted, it will loop through every cell that you've pasted, which will take far to long if you have a lot of cells. Try pasting, then running the following:-

Code: 
Public Sub ChangeColour()
Dim c As Range
Dim iColor As Integer

Application.ScreenUpdating = False
For Each c In Range("C1", Range("C65536").End(xlUp))
    Select Case c.Value
    Case "Degd Sv."
        iColor = 6
    Case "short Sv dis."
        iColor = 12
    Case "Sv Dis>5min"
        iColor = 7
    Case "long Sv dis"
        iColor = 53
    Case Else
        iColor = xlColorIndexNone
    End Select
    c.Interior.ColorIndex = iColor
Next c
Application.ScreenUpdating = True

End Sub
 
Upvote 0
(y) Mudface, you made my day....or should I say night. Your proposal solved all problems I ran into.

Thanks a million (y)
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Question
VBA loop through date type mismatch
2
Replies
19
Views
841
Georgiboy
Georgiboy
J
  • Question
Conditional formatting causing copying issues
Replies
3
Views
181
Fluff
Fluff
WaterGypsy
  • Question
How can I 'freeze' conditional formatting
Replies
1
Views
451
Special-K99
S
J
  • Question
Big challenge: Use arrays to copy multiple columns, paste in different worksheets, and repeat for many data points!
Replies
0
Views
565
Jlascu
J
JeffGrant
  • Solved
When is a workbook too big?
2
Replies
11
Views
1K
Michael M
Michael M

Forum statistics

Threads
1,215,833
Messages
6,127,162
Members
449,368
Latest member
JayHo

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