Worksheet_Change Woes

L

Living the Dream

Hi Guys

I am wanting to use the following code, which to an extent works, but then fails on the 2nd IF. this code is attached to the Inbound Sheet.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Row < 5 Then Exit Sub

On Error GoTo ErrHandler

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

If Target.Column = 11 Then
If IsNumeric(Target.Value) Then
With Target
.Offset(, -10).Resize(, 14).Interior.ColorIndex = 6
.Offset(, -9).Select
End With

Call Module8.Plus_Chep_Out

If Target.Value = "" Then
With Target
.Offset(, -10).Resize(, 14).Interior.ColorIndex = 2
.Offset(, -9).Select
End With

Call Module8.Minus_Chep_Out

End If
End If
End If

ErrHandler:

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub

If I enter a number in column 11, it fires the "Plus_Chep" call, but! When I delete the number from the same cell, I fully expect it to call "Minus_Chep"and remove the cell colouring from the Outbound sheet, but it does not.

Both Call codes are identical with the exception that one colours and the other removes it.

The frustrating part is that it partially fires the Minus_Chep call by activating the sheet in question and going to the matching cell in the find: criteria but does not remove the colouring.

I was considering using a Case Select but wasn't quite sure which would be the best approach for it.

As always

Heaps of thanks in advance, and my glass is still half full.

Cheers
Mick.

Sub Plus_Chep_Out()

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

lookfor = Selection.Value
Sheets("Outbound").Activate
Cells.Find(What:=lookfor, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Select

With Selection
.Offset(, -4).Resize(, 14).Interior.ColorIndex = 6
End With

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub

Sub Minus_Chep_Out()

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

lookfor = Selection.Value
Sheets("Outbound").Activate
Cells.Find(What:=lookfor, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Select

With Selection
.Offset(, -4).Resize(, 14).Interior.ColorIndex = 2
End With

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub
 
V

Volker Neurath

Living said:
If I enter a number in column 11, it fires the "Plus_Chep" call, but! When
I delete the number from the same cell, I fully expect it to call
"Minus_Chep"and remove the cell colouring from the Outbound sheet, but it
does not.
Click to expand...

What does it do instead?
Did you try this in single-step mode?

If not:
pls set a stop in line:
If Target.Column = 11 Then

and then run that code again (with no value in Col 11) an when code stops
step through using F8.

Pls tell the result here ...

And you can then try the following:

Replace line
If Target.Value = "" Then

with

If Target.Value = "" or IsEmpty(Target.Value) Then

and check if result is the same.

This because "" and Empty ist NOT the same.

Volker
 
C

Claus Busch

Hi Mick,

Am Fri, 27 Sep 2013 23:11:10 -0700 (PDT) schrieb Living the Dream:
I am wanting to use the following code, which to an extent works, but then fails on the 2nd IF. this code is attached to the Inbound Sheet.
Click to expand...

try in code window of the sheet:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Row < 5 Or Target.Column <> 11 Then Exit Sub

If IsNumeric(Target.Value) Then
With Target
.Offset(, -10).Resize(, 14).Interior.ColorIndex = 6
lookfor = .Offset(, -9)
End With
Plus_Chep_Out
End If

If IsEmpty(Target) Then
With Target
lookfor = .Offset(, -9)
.Offset(, -10).Resize(, 14).Interior.Color = xlNone
End With
Minus_Chep_Out
End If

End Sub

And in a standard module:

Public lookfor As String

Sub Plus_Chep_Out()
Dim c As Range

Sheets("Outbound").Activate
With ActiveSheet
Set c = .UsedRange.Find(lookfor, .Range("A1"), _
xlValues).Offset(, -4)
End With
If Not c Is Nothing Then _
c.Resize(columnsize:=14).Interior.ColorIndex = 6

End Sub

Sub Minus_Chep_Out()
Dim c As Range

Sheets("Outbound").Activate
With ActiveSheet
Set c = .UsedRange.Find(lookfor, .Range("A1"), _
xlValues).Offset(, -4)
End With
If Not c Is Nothing Then _
c.Resize(columnsize:=14).Interior.Color = xlNone

End Sub


Regards
Claus B.
 
G

GS

Adding to Volker's comments/Qs...

Is there always only going to be 1 cell changed at a time?

Are you looking for a mechanism to *undo* previously shaded cells?

Have you tried shading via using Conditional Formatting criteria?

Attempting to process "" as a value for unshading previously shaded
cells is futile at best since there's going to be 10s of 1000s of empty
cells whether you're looking for an empty string returned by a formula
*or* testing if the cell =Empty. As Volker states.., these are 2
different things!<g> Better to store the previous value used as
criteria for shading and pull it into play when Target.Value ="" or
=Empty. Simplest way to test for both is to use IsEmpty()...

If IsEmpty(Target) Then lColorNdx = 0 else lColorNdx = 6


Another suggestion/recommendation is to get in the habit of using
object events as triggers for calling some process, but not running the
process within the event...

In the sheet's cde window:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 4 And Target.Column = 11 Then _
Call Toggle_ChepOut_Shading(Target, Target.Offset(, -9).Value)
End Sub


In a standard module:
Option Explicit

Sub Toggle_ChepOut_Shading(Target As Range, LookupVal)
Dim lColorNdx&, rngFind As Range, sAddr$

If IsEmpty(Target) Then lColorNdx = 0 Else lColorNdx = 6

If IsEmpty(Target) Or IsNumeric(Target.Value) Then
Target.Offset(, -10).Resize(, 14).Interior.ColorIndex = lColorNdx
With Sheets("Outbound").UsedRange
Set rngFind = .Find(What:=LookupVal, _
After:=.Cells(1), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not rngFind Is Nothing Then
sAddr = rngFind.Address
Do
rngFind.Offset(, -4).Resize(, 14).Interior.ColorIndex =
lColorNdx
Set rngFind = .FindNext(rngFind)
Loop While Not rngFind Is Nothing And rngFind.Address <> sAddr
End If 'Not rngFind Is Nothing
End With 'Wks
End If
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
G

GS

Catch the typo, and see added comments below...

In the sheet's code window:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 4 And Target.Column = 11 Then _
Call Toggle_ChepOut_Shading(Target, Target.Offset(, -9).Value)
End Sub


In a standard module:
Option Explicit

Sub Toggle_ChepOut_Shading(Target As Range, LookupVal)
Dim lColorNdx&, rngFind As Range, sAddr$

If IsEmpty(Target) Then lColorNdx = 0 Else lColorNdx = 6

If IsEmpty(Target) Or IsNumeric(Target.Value) Then
Target.Offset(, -10).Resize(, 14).Interior.ColorIndex = lColorNdx
With Sheets("Outbound").UsedRange
Set rngFind = .Find(What:=LookupVal, _
After:=.Cells(1), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not rngFind Is Nothing Then
sAddr = rngFind.Address
Do
rngFind.Offset(, -4).Resize(, 14).Interior.ColorIndex =
lColorNdx
Set rngFind = .FindNext(rngFind)
Loop While Not rngFind Is Nothing And rngFind.Address <>
sAddr
End If 'Not rngFind Is Nothing
End With 'Wks
End If
End Sub
Click to expand...

Note that this sub will find all occurances of LookupVal in case it's
not unique. Otherwise, if you're happy with finding only the 1st
instance then comment out the Do...Loop While!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
C

Claus Busch

Hi Mick,

Am Fri, 27 Sep 2013 23:11:10 -0700 (PDT) schrieb Living the Dream:
If IsNumeric(Target.Value) Then
With Target
.Offset(, -10).Resize(, 14).Interior.ColorIndex = 6
.Offset(, -9).Select
End With
Click to expand...

if your target is empty the value is 0. And 0 is also numeric. Therefore
you get in both conditions the yellow background.
Change the order of the conditions. Set IsEmpty as first condition:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myC As Integer

If Target.Row < 5 Or Target.Column <> 11 Then Exit Sub

If IsEmpty(Target) Then
myC = 0
ElseIf IsNumeric(Target) Then
myC = 6
End If

With Target
.Offset(, -10).Resize(, 14).Interior.ColorIndex = myC
lookfor = .Offset(, -9)
End With

If myC = 6 Then
Plus_Chep_Out
Else
Minus_Chep_Out
End If

End Sub


Regards
Claus B.
 
L

Living the Dream

Hi everyone, A massive thank you to all for your contribution.

Claus' code works really well.

Please accept my appreciation for all of your time.

You guys never fail to help put that little extra shine on the Duco of my workbooks.

Thanks again.

Cheers
Mick.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Pass condition formatting across worksheets via vba. 0
Unhide sheet, copy and rename new sheets from list, rehide sheet 8
Change a great number of words in word files, with a macro as short as possible. 5
Word macro that can call cells out of Excel for a find and replace 0
Making a macro only work on certain files 2
VBA Coding Help for Beginner 0
Desire ChangeEvent not triggered if ChangeEvent was column (field) insertion 10
Mail a different file(s) to each person in a range 0

Top