Worksheet Change event only works the second time a change occurs

N

Nichole09

Board Regular
Joined
Aug 27, 2016
Messages
132
Hello All,

I am really hoping to get some advise as this problem has been driving me crazy for about a week now. I have tried many different variations of the below code and nothing seems to make a different. There are a lot of lines in this code but my main concern is regarding the cell "O2" near the bottom. The ranges referred to above work just fine. For some odd reason, the line O2 only works after a second change happens within that cell. Every time after that works perfectly. I cant understand why the first time it does not work!! A loan number should go into cell O2. If I do that when I open the sheet it doesn't work. If I simply hit enter again, in the same cell, (not typing anything new) then it works. Same with deleting it and re-entering it. I need it to work, the first time a loan number is entered into cell O2. I would greatly appreciate any advise.

Things I have tried:
changing the line to: If Not Intersect(Target, Range("O2")) Is Nothing Then ---- same thing with putting $O$2
putting application.enableevents = false under each line --- I know this probably isn't necessary but I couldn't figure out what else to do and thought maybe this was the problem
putting application.enableevents = true in the immediately window each time I open the worksheet ------------doing that a million times didn't do anything either
putting an errorhandler - the macro1 you see in the code is just a macro that has application.enableevents = true in it ----- again, trying anything here....

please help!!!



VBA Code: 
Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer, x As Integer, l As Integer, k As Integer, b As Integer, e As Integer
Dim a As Integer, c As Integer, d As Integer, f As Integer
Dim lrow As Long, lrowLOS1 As Long, lrowLOS2 As Long, lrowHIST As Long, lrowNOTES As Long
Dim ws As Worksheet, ws4 As Worksheet, wsLOS As Worksheet, wsNOTES As Worksheet, wsHIST As Worksheet
Dim wb As Workbook
Dim notes As String, user As String, datestamp As String
Dim LOSname As String, shtname As String
Dim namelen As Long
Dim w As Integer, m As Integer
Dim keycells As Range


Application.EnableEvents = False
Application.ScreenUpdating = False


Set wb = Workbooks("Template")
Set ws = wb.Worksheets("Template")
Set ws4 = wb.Worksheets("Sheet4")
Set wsNOTES = wb.Worksheets("Loan Notes")
Set wsHIST = wb.Worksheets("Loan History")
Set wsLOS = wb.Worksheets("Data")
lrow = ws4.cells(ws4.Rows.Count, "B").End(xlUp).Row
lrowLOS1 = wsLOS.cells(wsLOS.Rows.Count, "A").End(xlUp).Row
'lrowLOS1 is for notes in LOS Data
lrowNOTES = wsNOTES.cells(wsNOTES.Rows.Count, "B").End(xlUp).Row
'lrowLOS2 is for history
lrowLOS2 = wsLOS.cells(wsLOS.Rows.Count, "G").End(xlUp).Row
lrowHIST = wsHIST.cells(wsHIST.Rows.Count, "B").End(xlUp).Row


ws.Unprotect Password:="GOTEAM"
wsNOTES.Unprotect Password:="GOTEAM"
 wsHIST.Unprotect Password:="GOTEAM"

 
On Error GoTo ErrorHandler

Application.EnableEvents = False
Set Target = ws.Range("F8")
If Target.Address <> "$F$8" Then Exit Sub
If Target <> "" Then
For i = 2 To lrow
namelen = Len(ws.Range("F8")) - Len(WorksheetFunction.Substitute(ws.Range("F8"), " ", ""))

If namelen <= 1 Then
shtname = Trim(Right(ws.Range("F8").Value, (Len(ws.Range("F8").Value) - InStr(ws.Range("F8").Value, " "))))
Else
shtname = Trim(Right(ws.Range("F8").Value, (Len(ws.Range("F8").Value) - InStrRev(ws.Range("F8").Value, " "))))
End If

LOSname = Trim(Right(ws4.cells(i, "B").Value, (Len(ws4.cells(i, "B").Value) - InStrRev(ws4.cells(i, "B").Value, " "))))
If LOSname = shtname Then
ws.Range("F9").Value = ws4.cells(i, "E").Value
ws.Range("O8").Value = ws4.cells(i, "D").Value
Exit For
Else
End If
Next i

Else
ws.Range("F9").Value = ""
End If


Set Target = ws.Range("F10")
If Target.Address <> "$F$10" Then Exit Sub
If Target <> "" Then
For x = 2 To lrow
 namelen = Len(ws.Range("F10")) - Len(WorksheetFunction.Substitute(ws.Range("F10"), " ", ""))

If namelen <= 1 Then
shtname = Trim(Right(ws.Range("F10").Value, (Len(ws.Range("F10").Value) - InStr(ws.Range("F10").Value, " "))))
Else
shtname = Trim(Right(ws.Range("F10").Value, (Len(ws.Range("F10").Value) - InStrRev(ws.Range("F10").Value, " "))))
End If

LOSname = Trim(Right(ws4.cells(x, "B").Value, (Len(ws4.cells(x, "B").Value) - InStrRev(ws4.cells(x, "B").Value, " "))))
If LOSname = shtname Then
ws.Range("F11").Value = ws4.cells(x, "E").Value
ws.Range("O10").Value = ws4.cells(x, "D").Value
Exit For
Else
End If

Next x

Else
 ws.Range("F11").Value = ""

 End If

 Set Target = ws.Range("F12")
If Target.Address <> "$F$12" Then Exit Sub
If Target <> "" Then
For l = 2 To lrow
 namelen = Len(ws.Range("F12")) - Len(WorksheetFunction.Substitute(ws.Range("F12"), " ", ""))

If namelen <= 1 Then
shtname = Trim(Right(ws.Range("F12").Value, (Len(ws.Range("F12").Value) - InStr(ws.Range("F12").Value, " "))))
Else
shtname = Trim(Right(ws.Range("F12").Value, (Len(ws.Range("F12").Value) - InStrRev(ws.Range("F12").Value, " "))))
End If

LOSname = Trim(Right(ws4.cells(l, "B").Value, (Len(ws4.cells(l, "B").Value) - InStrRev(ws4.cells(l, "B").Value, " "))))
If LOSname = shtname Then
ws.Range("F13").Value = ws4.cells(l, "E").Value
ws.Range("O12").Value = ws4.cells(l, "D").Value
Exit For
Else
End If

Next l

Else
 ws.Range("F13").Value = ""

 End If

Set Target = ws.Range("F14")
If Target.Address <> "$F$14" Then Exit Sub
If Target <> "" Then
For k = 2 To lrow
 namelen = Len(ws.Range("F14")) - Len(WorksheetFunction.Substitute(ws.Range("F14"), " ", ""))

 If namelen <= 1 Then
shtname = Trim(Right(ws.Range("F14").Value, (Len(ws.Range("F14").Value) - InStr(ws.Range("F14").Value, " "))))
Else
shtname = Trim(Right(ws.Range("F14").Value, (Len(ws.Range("F14").Value) - InStrRev(ws.Range("F14").Value, " "))))
End If

LOSname = Trim(Right(ws4.cells(k, "B").Value, (Len(ws4.cells(k, "B").Value) - InStrRev(ws4.cells(k, "B").Value, " "))))
If LOSname = shtname Then
ws.Range("F15").Value = ws4.cells(k, "E").Value
ws.Range("O14").Value = ws4.cells(k, "D").Value
Exit For
Else
End If

Next k

Else
 ws.Range("F15").Value = ""

 End If

Set Target = ws.Range("F16")
If Target.Address <> "$F$16" Then Exit Sub
If Target <> "" Then
For b = 2 To lrow
 namelen = Len(ws.Range("F16")) - Len(WorksheetFunction.Substitute(ws.Range("F16"), " ", ""))

 If namelen <= 1 Then
shtname = Trim(Right(ws.Range("F16").Value, (Len(ws.Range("F16").Value) - InStr(ws.Range("F16").Value, " "))))
Else
shtname = Trim(Right(ws.Range("F16").Value, (Len(ws.Range("F16").Value) - InStrRev(ws.Range("F16").Value, " "))))
End If

LOSname = Trim(Right(ws4.cells(b, "B").Value, (Len(ws4.cells(b, "B").Value) - InStrRev(ws4.cells(b, "B").Value, " "))))
If LOSname = shtname Then
ws.Range("F17").Value = ws4.cells(b, "E").Value
ws.Range("O16").Value = ws4.cells(b, "D").Value
Exit For
Else
End If

Next b

Else
 ws.Range("F17").Value = ""

 End If

Set Target = ws.Range("F18")
If Target.Address <> "$F$18" Then Exit Sub
If Target <> "" Then
For e = 2 To lrow
 namelen = Len(ws.Range("F18")) - Len(WorksheetFunction.Substitute(ws.Range("F18"), " ", ""))

If namelen <= 1 Then
shtname = Trim(Right(ws.Range("F18").Value, (Len(ws.Range("F18").Value) - InStr(ws.Range("F18").Value, " "))))
Else
shtname = Trim(Right(ws.Range("F18").Value, (Len(ws.Range("F18").Value) - InStrRev(ws.Range("F18").Value, " "))))
End If

LOSname = Trim(Right(ws4.cells(e, "B").Value, (Len(ws4.cells(e, "B").Value) - InStrRev(ws4.cells(e, "B").Value, " "))))
If LOSname = shtname Then
ws.Range("F19").Value = ws4.cells(e, "E").Value
ws.Range("O18").Value = ws4.cells(e, "D").Value
Exit For
Else
End If

Next e

Else
 ws.Range("F19").Value = ""

 End If

' STARTING HERE IS MY PROBLEM
On Error Resume Next
Application.EnableEvents = False
Set Target = ws.Range("$O$2")
On Error Resume Next
Application.EnableEvents = False
If Target.Address <> "$O$2" Then Exit Sub
On Error Resume Next
Application.EnableEvents = False
If Target > 1 Then
Application.EnableEvents = False
ws.Range("O4").Value = wsLOS.Range("M2").Value
' above is status
ws.Range("O3").Value = wsLOS.Range("N2").Value
'above is borrower name


For a = 2 To lrowLOS1
user = wsLOS.cells(a, "B").Value
datestamp = Trim(Left(wsLOS.cells(a, "D").Value, InStrRev(wsLOS.cells(a, "D").Value, " ")))
notes = wsLOS.cells(a, "B").Offset(0, -1).Value
wsNOTES.cells(a, "B").Value = user & " - " & datestamp
wsNOTES.cells(a, "E").Value = notes
wsNOTES.cells(a, "B").Value = Trim(Left(wsNOTES.cells(a, "B").Value, InStrRev(wsNOTES.cells(a, "B").Value, " ")))


Const SpareCol As Long = 26
Set rng = wsNOTES.Range(("E" & a & ":" & "P") & Range("E" & Rows.Count).End(xlUp).Row)

With rng
For j = 1 To .Rows.Count
'if the row is not hidden
If Not .Parent.Rows(.cells(j, 1).Row).Hidden Then
'if the cells have data
If Application.WorksheetFunction.CountA(.Rows(j)) Then
MaxRH = 0
For n = .Columns.Count To 1 Step -1
If Len(.cells(j, n).Value) Then
'mergecells
If .cells(j, n).MergeCells Then
Set rngMArea = .cells(j, n).MergeArea
With rngMArea
MW = 0
If .wrapText Then
'get the total width
For w = 1 To .cells.Count
MW = MW + .Columns(w).ColumnWidth
Next
MW = MW + .cells.Count * 0.66
'use the spare column and put the value, make autofit, get the row height
With .Parent.cells(.Row, SpareCol)
.Value = rngMArea.Value
.ColumnWidth = MW
.wrapText = True
.EntireRow.AutoFit
RH = .RowHeight
MaxRH = Application.Max(RH, MaxRH)
.Value = vbNullString
.wrapText = False
.ColumnWidth = 8.43
End With
.RowHeight = MaxRH
End If
End With
ElseIf .cells(j, n).wrapText Then
RH = .cells(j, n).RowHeight
.cells(j, n).EntireRow.AutoFit
If .cells(j, n).RowHeight < RH Then .cells(j, n).RowHeight = RH
End If
End If
Next
End If
End If
Next
.Parent.Parent.Worksheets(.Parent.Name).UsedRange
End With

Next a


For c = 2 To lrowLOS2
user = wsLOS.cells(c, "I").Value & " " & wsLOS.cells(c, "J").Value
datestamp = Trim(Left(wsLOS.cells(c, "H").Value, InStrRev(wsLOS.cells(c, "H").Value, " ")))
notes = wsLOS.cells(c, "G").Value
wsHIST.cells(c, "B").Value = user & " - " & datestamp
wsHIST.cells(c, "E").Value = notes
wsHIST.cells(c, "B").Value = Trim(Left(wsHIST.cells(c, "B").Value, InStrRev(wsHIST.cells(c, "B").Value, " ")))

 Const SpareCol1  As Long = 26
Set rng1 = wsHIST.Range(("E" & c & ":" & "P") & Range("E" & Rows.Count).End(xlUp).Row)

With rng1
For j = 1 To .Rows.Count
'if the row is not hidden
If Not .Parent.Rows(.cells(j, 1).Row).Hidden Then
'if the cells have data
If Application.WorksheetFunction.CountA(.Rows(j)) Then
MaxRH = 0
For n = .Columns.Count To 1 Step -1
If Len(.cells(j, n).Value) Then
'mergecells
If .cells(j, n).MergeCells Then
Set rngMArea = .cells(j, n).MergeArea
With rngMArea
MW = 0
If .wrapText Then
'get the total width
For m = 1 To .cells.Count
MW = MW + .Columns(m).ColumnWidth
Next
MW = MW + .cells.Count * 0.66
'use the spare column and put the value, make autofit, get the row height
With .Parent.cells(.Row, SpareCol)
.Value = rngMArea.Value
.ColumnWidth = MW
.wrapText = True
.EntireRow.AutoFit
RH = .RowHeight
MaxRH = Application.Max(RH, MaxRH)
.Value = vbNullString
.wrapText = False
.ColumnWidth = 8.43
End With
.RowHeight = MaxRH
End If
End With
ElseIf .cells(j, n).wrapText Then
RH = .cells(j, n).RowHeight
.cells(j, n).EntireRow.AutoFit
If .cells(j, n).RowHeight < RH Then .cells(j, n).RowHeight = RH
End If
End If
Next
End If
End If
Next
.Parent.Parent.Worksheets(.Parent.Name).UsedRange
    End With


Next c


Else

ws.Range("O4").Value = ""
' above is status
ws.Range("O3").Value = ""
'above is borrower name


For a = 2 To lrowLOS1
wsNOTES.cells(a, "B").Value = ""
wsNOTES.cells(a, "E").Value = ""
Next a


For c = 2 To lrowLOS2
wsHIST.cells(c, "B").Value = ""
wsHIST.cells(c, "E").Value = ""
Next c

End If


ErrorHandler:
Call macro1


ws.Protect Password:="GOTEAM"
wsNOTES.Protect Password:="GOTEAM"
 wsHIST.Protect Password:="GOTEAM"



  Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Sort by date Sort by votes
Without the files needed to run the code it is going to be near impossible to find the cause of such an anomaly in so many lines of code.
I have noticed that you're using 'Set Target' in several places, this will be breaking the link to the actual Target cell, which could well be the cause of the problem. Most likely the code is working the first time that a change is made, but it is ending without doing anything useful due to the way that it has been written.

Normal practice would be to keep Target as the original range that triggered the code, then use a second range, e.g. Set rng = Target and manipulate rng as needed while keeping Target tied to the original cell.
 
Upvote 0
Hi,

What a lot of code but glancing through it you have lines of code like this

Rich (BB code): 
Application.EnableEvents = False

Set Target = ws.Range("F8")

If Target.Address <> "$F$8" Then Exit Sub


You MUST explicitly reset EnableEvents to True BEFORE exiting the code otherwise all events will continue to be disabled.

Suggest that you amend your Exit Subs to Goto ErrorHandler to direct codes exit at this point where you reset the event

Hope Helpful

Dave
 
Upvote 0
Try adding some code to help you understand what is going on. You can remove the msgbox statements later.

VBA Code: 
    ' STARTING HERE IS MY PROBLEM
    Dim CellRange As Range
    On Error Resume Next
    Set CellRange = ws.Range("O2")
    On Error GoTo ErrorHandler

    If Not CellRange Is Nothing Then
        Set Target = CellRange
          MsgBox "Target address: " & Target.Address, , "Success"
    End If

    If Target.Address <> "$O$2" Then
        MsgBox "Abort. Bad Target address: " & Target.Address, vbCritical, "Target.Address <> $O$2"
        Exit Sub
    End If
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question
Worksheet Change Event
Replies
2
Views
380
sspatriots
S
H
  • Solved
Amend the VBA code to Filter Columns Instead of Rows
Replies
9
Views
164
Akuini
Akuini
mehidy1437
  • Question
Requesting for experts comments suggestion on my vba code
Replies
5
Views
694
mehidy1437
mehidy1437
S
  • Solved
Working with multiple Target Ranges in Worksheet Code
Replies
3
Views
376
sspatriots
S
Guna13
  • Question
Help to Optimize Macro Code for Faster Performance
Replies
0
Views
752
Guna13
Guna13

Forum statistics

Threads
1,215,046
Messages
6,122,855
Members
449,096
Latest member
Erald

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