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!!!
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