Hi all,
My macro stops working before finishing the code.
Strangely, it has worked for the past 5+ months and when trying to run today, it just stops!
Code below :
In the code I have indicated where it stops.
I have gone through the code line by line (F8) and it just stops working, no prompt, no message, like it was meant to stop!
Any explanation and workaround is greatly appreciated.
My macro stops working before finishing the code.
Strangely, it has worked for the past 5+ months and when trying to run today, it just stops!
Code below :
VBA Code:
Sub OneA_Auto()
Dim lRow As Long
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, ws5 As Worksheet
Dim rng1 As Range, ONEa As Range
Set ws1 = Worksheets("1a boxi")
Set ws2 = Worksheets("1a list of client services")
Set ws3 = Worksheets("1a unique clients list")
Set ws4 = Worksheets("Raw Boxi")
Set ws5 = Worksheets("Macro Centre")
ws4.Activate
lRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
ws4.Range("A2:Q" & lRow).Copy
ws1.Activate
Range("A2").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
lRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Set rng1 = Range("R3:T" & lRow)
ws1.Range("R3").Formula = "=TEXTJOIN("","",TRUE,A3,K3,L3)"
ws1.Range("S3").Formula = "=XLOOKUP(K3,'PSR lookup'!A:A,'PSR lookup'!B:B,"""")"
ws1.Range("T3").Formula = "=COUNTIF(R$3:R3,R3)"
ws1.Range("R3:T3").AutoFill _
Destination:=rng1, Type:=xlFillDefault
rng1.Value = rng1.Value
'--Delete all duplicates (all non-1's)
lRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
With ActiveSheet
.AutoFilterMode = False
With Range("A2:T" & lRow)
.AutoFilter Field:=20, Criteria1:="<>1"
On Error Resume Next
.Offset(1).SpecialCells(12).EntireRow.Delete
End With
.AutoFilterMode = False
End With
lRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
ws1.Range("A2:Q" & lRow).Copy
'-- Moving to Sheet 1a client services
ws2.Activate
Range("A1").PasteSpecial Paste:=xlPasteValues
'-- Finding the last cell in Column A in Sheet 1b client services
lRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
With Range("A2:A" & lRow)
.NumberFormat = "General"
.Value = .Value
End With
'--Copy client list from 1a client services and remove duplicates to paste into 1a unique clients list
ws2.Range("A1:A" & lRow).Cells(1, 1).Copy ws3.Cells(3, 1)
ws2.Range("A1:A" & lRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws3.Range("A2").Value, Unique:=True
'==============STOPS WORKING HERE!!!!========================
'-- Create formulas
ws3.Activate
'--Client lines
ws3.Range("B3").Formula = "=COUNTIF('1a list of client services'!A:A,A3)"
'--Count of non-DP Services
ws3.Range("C3").Formula = "=COUNTIFS('1a list of client services'!A:A,$A3,'1a list of client services'!O:O,0)"
'--Age Band
ws3.Range("D3").Formula = "=XLOOKUP(A3,'1a list of client services'!A:A,'1a list of client services'!F:F,"""",0)"
'--PSR
ws3.Range("E3").Formula = "=XLOOKUP(XLOOKUP(A3,'1a list of client services'!A:A,'1a list of client services'!K:K,"""",0),'PSR lookup'!A:A,'PSR lookup'!B:B,"""",0)"
'--SATL: Support Setting/Delivery Mechanism
ws3.Range("F3").Formula = "=IF(H3=1,""1. Nursing"",IF(I3=1,""2. Residential"",IF(AND(J3=1,C3=0),""3. Direct Payments"",IF(AND(J3=1,C3>0),""4. Part Direct Payments"",""5. CASSR Managed Personal Budget""))))"
'--Unique ID
ws3.Range("G3").Formula = "=TEXTJOIN("","",FALSE,A3,F3)"
'--Nursing Indicator
ws3.Range("H3").Formula = "=COUNTIFS('1a list of client services'!$M:$M,"">0"",'1a list of client services'!$A:$A,$A3)"
'--Residential Indicator
ws3.Range("I3").Formula = "=COUNTIFS('1a list of client services'!$N:$N,"">0"",'1a list of client services'!$A:$A,$A3)"
'--Direct Payment Indicator
ws3.Range("J3").Formula = "=COUNTIFS('1a list of client services'!$O:$O,"">0"",'1a list of client services'!$A:$A,$A3)"
'--Hierachy Test
ws3.Range("K3").Formula = "=COUNTIFS('1a list of client services'!$P:$P,"">0"",'1a list of client services'!$A:$A,$A3)"
'--Other Indicator
ws3.Range("L3").Formula = "=COUNTIFS('1a list of client services'!$Q:$Q,"">0"",'1a list of client services'!$A:$A,$A3)"
'-- Defining 1a unique clients list formula range
lRow2 = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Set ONEa = Range("B3:L" & lRow2)
'-- Autofill Formulas and turn them into hard values
ws3.Range("B3:L3").AutoFill _
Destination:=ONEa, Type:=xlFillDefault
ONEa.Value = ONEa.Value
ws5.Activate
End SubIn the code I have indicated where it stops.
I have gone through the code line by line (F8) and it just stops working, no prompt, no message, like it was meant to stop!
Any explanation and workaround is greatly appreciated.
