Worksheet_SelectionChange goes cold

R

Rob

Hi all,
I have a Worksheet_SelectionChange on a worksheet together with a
Worksheet_Change event. The procedure generally works great but every so
often, part of the Selection change does not perform as it should. That is,
it is supposed to bring up a userform when a cell in a certain column is
selected. As I said, this usually works, but now and then, the user form
does not appear. The other strange thing is that that same column/cell when
selected also brings up a message box should some conditions not be met. If
the conditions are met, the userform appears. When the procedure does not
work, the message box still appears if I un-meet a condition but not the
userform.
The only way I can resolve this is to bring up the VBA code and click the
reset button. Then all's well again. It does not say it's in break mode when
it isn't working as that would mean all the change events would be disabled,
but they're not!
I cannot see any change or action happening when I click the reset button.
All I know is that when doing that, the procedure and userform will work
faultlessly again as it should.

Has anybody got any clues? It's very annoying as it only occurs
infrequently and although I can resolve the problem, the program is intended
to be used by another user.

Rob
 
M

mark

Gidday,

Maybe it only works when a set number of characters is
typed or does not change if text is pasted into cell or
only works when tab key or return key is pressed.

You may have to set the events to accept a key event or
lost focus event.

Mark
 
R

Rob

Thanks for the suggestion Mark, but that is not the problem. The event
occurs no matter how I enter the cell.....well 99.99% of the time. It's the
0.01% times that's confusing as I don't do anything different. What also
confuses the matter is, why should it begin to work again after going into
the VBA and clicking reset??? AND why does the other event still work in
the same cell?? It's just the userform that doesn't appear.

Rob
 
B

Bob Phillips

Post the code


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
M

Mark E. Philpot

If you are using 2 events for the same sheet, one of them
always goes first. You could "Call" the other event via
the first, whichever that is.

Mark
 
R

Rob

Hi Bob,
I thought someone might suggest this but I feel the whole workbook will need
to be evaluated as it's turned into a rather complicated nightmare.
The specific code for the sheet is below but there is heaps more code it
refers to. I can understand that all this may be too much to resolve,
particularly as it's VERY intermittent.
I have trouble myself in working out what it all does as a lot has been
taken from very kind people in this newsgroup. I just bundled it together
as best I could and made amendments as much as was needed to make it all
"happen".

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim otherCell As Range
On Error GoTo errHandler:
'to bypass everything up to BalCol if in Bal mode
If Not Intersect(Target, Me.Range("N26:N1525")) Is Nothing Then GoTo
BalCol

'to remove code selected if A'C name is changed
If Not Intersect(Target, Me.Range("G26:G1525")) Is Nothing Then
If ActiveCell.Offset(0, 6) = "" Then Exit Sub
Sheet4.Unprotect
ActiveCell.Offset(0, 6).Resize(1, 5).ClearContents
Sheet4.Protect
ActiveCell.Offset(0, 6).Select
End If
'Exit if more than 1 cell is selected in target range
If Target.Cells.Count > 1 Then Exit Sub
'code to not allow debit AND credit
'Exit if active cell is not Debit or Credit
If Intersect(Target, Me.Range("I:J")) Is Nothing Then Exit Sub
'Exit if there is not a value in both debit and credit col
If Application.CountA(Me.Cells(Target.Row, "I").Resize(1, 2)) < 2
Then Exit Sub
'Set variable with amount in the adjacent cell
Set otherCell = Me.Cells(Target.Row, 19 - Target.Column)
Application.Goto Target
If Target.Column = 9 Then
If MsgBox("You cannot enter an amount for both credit and debit
for this item." _
& vbLf & "Select OK to keep the new amount and delete the
CREDIT amount of $" & otherCell.Value _
& vbLf & "Select Cancel to UNDO.", vbOKCancel) = vbCancel
Then
ActiveCell.ClearContents
Exit Sub
End If
Application.Goto Target
otherCell.ClearContents
Target.Offset(0, 4).ClearContents
Target.Offset(0, 4).Select
Exit Sub
Else
If MsgBox("You cannot enter an amount for both credit and debit
for this item." _
& vbLf & "Select OK to keep the new amount and delete the
DEBIT amount of $" & otherCell.Value _
& vbLf & "Select Cancel to UNDO.", vbOKCancel) = vbCancel
Then
ActiveCell.ClearContents
Exit Sub
End If
Target.Offset(0, 3).ClearContents
End If
Application.Goto Target
otherCell.ClearContents
Target.Offset(0, 3).Select
Exit Sub
BalCol:
'To lock some cells in balanced row
'If vBalMode = True Then Exit Sub 'If not in bal mode
'else

With Target
If UCase(.Value) = "X" Then
.Offset(0, -7).Resize(1, 2).Value = _
.Offset(0, -7).Resize(1, 2).Value 'Delete formula and
Cheque No
.Offset(0, -7).Resize(1, 7).Locked = True
.Offset(0, 2).Resize(1, 3).Locked = True
.Offset(0, -7).Resize(1, 7).Font.ColorIndex = 5
.Offset(0, -7).Validation.InCellDropdown = False
ElseIf .Value = "" Then
'To undo if X is deleted
.Offset(0, -7).Resize(1, 7).Locked = False
.Offset(0, 2).Resize(1, 3).Locked = False
.Offset(0, -7).Resize(1, 7).Font.ColorIndex = 0
.Offset(0, -7).Validation.InCellDropdown = True
End If
End With

errHandler:
Application.EnableEvents = True
End Sub
'Generally Code to bring up userforms for Code col
Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim PvtTable As PivotTable
On Error GoTo errHandler:
If vBalMode = True Then Exit Sub ' to prevent these procedures when
balancing
'Input Tax Credit column procedure
If Not Intersect(Target, Me.Range("O26:O1525")) Is Nothing Then
If ActiveCell.Offset(0, -10) = "X" Then GoTo GstMessage
If ActiveCell.Offset(0, -10) = "" Then
GstMessage:
If MsgBox("As no amount has been entered in the GST
SECTION, column 3," _
& vbLf & " this item does not apply for an Input Tax
Credit." _
& vbLf _
& vbLf & "Choose Yes if this item will not have an Input
Tax Credit." _
& vbLf _
& vbLf & "Choose No if you still need to show the Input
Tax credit (Gst) amount in the Gst Section.", vbYesNo, vbInformation) =
vbYes Then
ActiveCell.Value = "NA"
Exit Sub
End If
ActiveCell.ClearContents
ActiveCell.Offset(0, -10).Select
Exit Sub
End If
ufInputCreditMonth.Show
End If

'If active cell is not in this range then do nothing
If Intersect(Target, Me.Range("M26:M1525")) Is Nothing Then Exit Sub
'If more than 1 cell is active then do nothing
If Target.Cells.Count > 1 Then Exit Sub
'No account
If Me.Cells(Target.Row, "G") = "" Then
MsgBox "You need to select an account first. Do NOT skip any rows!."
ActiveCell.Offset(0, -6).Select
Exit Sub
End If
'no Debit or Credit
If Me.Cells(Target.Row, "I") = "" And Me.Cells(Target.Row, "J") = ""
Then
MsgBox "You need to enter an amount for Debit or Credit first."
ActiveCell.Offset(0, -4).Select
Exit Sub
End If
'No Date
If Me.Cells(Target.Row, "L") = "" Then
MsgBox "You need to enter a date first."
ActiveCell.Offset(0, -1).Select
Exit Sub
End If
If BASMonthMode = True Then Exit Sub ' to prevent these procedures when ente
ring GST Month
'otherwise select the correct pivot table fields
Select Case UCase(Me.Cells(Target.Row, "G").Value)
Case Is = UCase(Me.Range("G16").Value)
If Cells(Target.Row, "I") > 0 Then
Set PvtTable = Sheet15.PivotTables("PivotTable1")
ElseIf Cells(Target.Row, "J") > 0 Then
Set PvtTable = Sheet11.PivotTables("PivotTable1")
End If
Case Is = UCase(Me.Range("G17").Value)
If Cells(Target.Row, "I") > 0 Then
Set PvtTable = Sheet15.PivotTables("PivotTable2")
ElseIf Cells(Target.Row, "J") > 0 Then
Set PvtTable = Sheet11.PivotTables("PivotTable2")
End If
Case Is = UCase(Me.Range("G18").Value)
If Cells(Target.Row, "I") > 0 Then
Set PvtTable = Sheet15.PivotTables("PivotTable3")
ElseIf Cells(Target.Row, "J") > 0 Then
Set PvtTable = Sheet11.PivotTables("PivotTable3")
End If
Case Is = UCase(Me.Range("G19").Value)
If Cells(Target.Row, "I") > 0 Then
Set PvtTable = Sheet15.PivotTables("PivotTable4")
ElseIf Cells(Target.Row, "J") > 0 Then
Set PvtTable = Sheet11.PivotTables("PivotTable4")
End If
Case Is = UCase(Me.Range("G20").Value)
If Cells(Target.Row, "I") > 0 Then
Set PvtTable = Sheet15.PivotTables("PivotTable5")
ElseIf Cells(Target.Row, "J") > 0 Then
Set PvtTable = Sheet11.PivotTables("PivotTable5")
End If
Case Is = UCase(Me.Range("G21").Value)
If Cells(Target.Row, "I") > 0 Then
Set PvtTable = Sheet15.PivotTables("PivotTable6")
ElseIf Cells(Target.Row, "J") > 0 Then
Set PvtTable = Sheet11.PivotTables("PivotTable6")
End If
Case Is = UCase(Me.Range("G22").Value)
If Cells(Target.Row, "I") > 0 Then
Set PvtTable = Sheet15.PivotTables("PivotTable7")
ElseIf Cells(Target.Row, "J") > 0 Then
Set PvtTable = Sheet11.PivotTables("PivotTable7")
End If
Case Is = UCase(Me.Range("G23").Value)
If Cells(Target.Row, "I") > 0 Then
Set PvtTable = Sheet15.PivotTables("PivotTable8")
ElseIf Cells(Target.Row, "J") > 0 Then
Set PvtTable = Sheet11.PivotTables("PivotTable8")
End If
End Select
ufSelectCode.ListBox1.List _
= PvtTable.RowFields(1).DataRange.Resize(, 2).Value
ufSelectCode.Show
'Enter NA to Input Tax Col if Credit
If Target.Offset(0, -4) = "" Then Target.Offset(0, 2) = "NA"

Exit Sub

errHandler:
Application.EnableEvents = True
End Sub
 
R

Rob

Thanks for your advice, Mark. I think the whole procedure has become to
huge for me to understand enough to manipulate further. I posted the code
in response to Bob Phillip's reply which you may like to look at??

Rob
 
Top