Code only running once then error 91 with block error

LloydFinancials

Well-known Member
Joined
Apr 24, 2015
Messages
546
I get an error when running this code a second time. If I copy the word 'Changed' from the field header in the workbook and paste it in the FS14 = "Changed" line it will run ok again one time, then errors out again. Line erroring out is the MsgBox Rng14.column line.

Code:
Sub DDD()
Dim lri As Long
Dim lci As Long
Dim lr12 As Long
Dim lc12 As Long
Dim FS1 As String
Dim FS2 As String
Dim FS3 As String
Dim FS4 As String
Dim FS5 As String
Dim FS6 As String
Dim FS7 As String
Dim FS8 As String
Dim FS9 As String
Dim FS10 As String
Dim FS11 As String
Dim FS12 As String
Dim FS13 As String
Dim FS14 As String
Dim Rng1 As Range
Dim Rng1b As Range
Dim Rng2 As Range
Dim Rng22 As Range
Dim Rng3 As Range
Dim Rng4 As Range
Dim Rng5 As Range
Dim Rng6 As Range
Dim Rng7 As Range
Dim Rng8 As Range
Dim Rng9 As Range
Dim Rng10 As Range
Dim Rng11 As Range
Dim Rng12 As Range
Dim Rng13 As Range
Dim Rng14 As Range
FS1 = "Assignment"
FS2 = "Pstng Date"
FS3 = "Assignment 2"
FS4 = "LOB"
FS5 = "1 minus Rate"
FS6 = "Aging"
FS7 = "Bucket"
FS8 = "Customer"
FS9 = "Financial Impact"
FS10 = "Group ID"
FS11 = "LOBBucket"
FS12 = "Subgroup ID"
FS13 = "Invoice Date"
FS14 = "Changed"

lri = Sheets("Invoice Dates").Cells(Rows.Count, 1).End(xlUp).Row
lci = Sheets("Invoice Dates").Cells(1, Columns.Count).End(xlToLeft).Column
lr12 = Sheets("1147110001 (2)").Cells(Rows.Count, 1).End(xlUp).Row
lc12 = Sheets("1147110001 (2)").Cells(1, Columns.Count).End(xlToLeft).Column
With Sheets("Invoice Dates").Rows(1)
    Set Rng1 = Cells.Find(What:=FS1, _
                    after:=Cells(1, 1), _
                    LookAt:=xlWhole, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
    Set Rng2 = Cells.Find(What:=FS2, _
                    after:=Cells(1, 1), _
                    LookAt:=xlWhole, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
    Set Rng14 = Cells.Find(What:=FS14, _
                    after:=Cells(1, 1), _
                    LookAt:=xlWhole, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
End With
MsgBox Rng14.Column
'Stop
Sheets("Invoice Dates").Select
ActiveSheet.UsedRange.Select
ActiveWorkbook.Worksheets("Invoice Dates").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Invoice Dates").Sort.SortFields.Add Key:= _
    Range(Cells(2, Rng1.Column).Address & ":" & Cells(lri, Rng1.Column).Address), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
    :=xlSortTextAsNumbers
ActiveWorkbook.Worksheets("Invoice Dates").Sort.SortFields.Add Key:= _
    Range(Cells(2, Rng2.Column).Address & ":" & Cells(lri, Rng2.Column).Address), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
    :=xlSortNormal
With ActiveWorkbook.Worksheets("Invoice Dates").Sort
    .SetRange Range("A1:" & Cells(lri, lci).Address)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Sheets("1147110001 (2)").Select
On Error Resume Next
    ActiveSheet.ShowAllData
On Error GoTo 0
'Cells(1, lc12 + 1).Select
'Selection.Value = "Invoice Date"
'Cells(1, lc12 + 2).Select
'Selection.Value = "LOB"
'Cells(1, lc12 + 3).Select
'Selection.Value = "Aging"
'Cells(1, lc12 + 4).Select
'Selection.Value = "Bucket"
'Cells(1, lc12 + 5).Select
'Selection.Value = "LOBBucket"
'Cells(1, lc12 + 6).Select
'Selection.Value = "1 minus Rate"
'Cells(1, lc12 + 7).Select
'Selection.Value = "Financial Impact"
'Cells(1, lc12 + 7).Select
'Selection.Value = "Customer"
'Cells(1, lc12 + 8).Select
'Selection.Value = "Group ID"
'Cells(1, lc12 + 9).Select
'Selection.Value = "Subgroup ID"
ActiveSheet.UsedRange.Select
Selection.AutoFilter
If ActiveSheet.AutoFilterMode = False Then
    Selection.AutoFilter
End If
With Sheets("1147110001 (2)").Rows(1)
    Set Rng1b = Cells.Find(What:=FS1, _
                    after:=Cells(1, 1), _
                    LookAt:=xlWhole, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
    Set Rng3 = Cells.Find(What:=FS3, _
                    after:=Cells(1, 1), _
                    LookAt:=xlWhole, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
    Set Rng4 = Cells.Find(What:=FS4, _
                    after:=Cells(1, 1), _
                    LookAt:=xlWhole, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
    Set Rng5 = Cells.Find(What:=FS5, _
                    after:=Cells(1, 1), _
                    LookAt:=xlWhole, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
    Set Rng6 = Cells.Find(What:=FS6, _
                    after:=Cells(1, 1), _
                    LookAt:=xlWhole, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
    Set Rng7 = Cells.Find(What:=FS7, _
                    after:=Cells(1, 1), _
                    LookAt:=xlWhole, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
    Set Rng8 = Cells.Find(What:=FS8, _
                    after:=Cells(1, 1), _
                    LookAt:=xlWhole, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
    Set Rng9 = Cells.Find(What:=FS9, _
                    after:=Cells(1, 1), _
                    LookAt:=xlWhole, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
    Set Rng10 = Cells.Find(What:=FS10, _
                    after:=Cells(1, 1), _
                    LookAt:=xlWhole, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
    Set Rng11 = Cells.Find(What:=FS11, _
                    after:=Cells(1, 1), _
                    LookAt:=xlWhole, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
    Set Rng12 = Cells.Find(What:=FS12, _
                    after:=Cells(1, 1), _
                    LookAt:=xlWhole, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
    Set Rng13 = Cells.Find(What:=FS13, _
                    after:=Cells(1, 1), _
                    LookAt:=xlWhole, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
    Set Rng22 = Cells.Find(What:=FS2, _
                    after:=Cells(1, 1), _
                    LookAt:=xlWhole, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
            
Cells(2, Rng13.Column).Select
ActiveCell.Formula = "=IFERROR(IF(AND(LEN(" & Cells(2, Rng3.Column).Address(rowabsolute:=False, columnabsolute:=False) & _
    ")=10,LEFT(" & Cells(2, Rng3.Column).Address(rowabsolute:=False, columnabsolute:=False) & ",3)=""100""),VLOOKUP(" & _
    Cells(2, Rng1b.Column).Address(rowabsolute:=False, columnabsolute:=False) & ",'Invoice Dates'!$A$1:$Z$" & lri & _
    "," & Rng14.Column & ",0),VLOOKUP(" & Cells(2, Rng3.Column).Address(rowabsolute:=False, columnabsolute:=False) & _
    ",'Invoice Dates'!$A$1:$Z$" & lri & "," & Rng2.Column & ",0))," & Cells(2, Rng22.Column).Address(rowabsolute:=False, columnabsolute:=False) & ")"
    
    Range(Cells(2, Rng13.Column).Address).Select
    Selection.AutoFill Destination:=Range(Cells(2, Rng13.Column).Address & ":" & Cells(lr12, Rng13.Column).Address)
'    Range(Cells(2, Rng13.Column).Address).Select
'    Range(Selection, Selection.End(xlDown)).Select
'    Selection.Copy
'    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'    Application.CutCopyMode = False
End With
'ActiveCell.Formula = "=IFERROR(IF(AND(LEN(P2)=10,LEFT(P2,4)=""1010""),VLOOKUP(H2,'Invoice Dates'!$A$1:$M$4221,13,0),VLOOKUP(H2,'Invoice Dates'!$A$1:$K$4221,11,0)),C2)"
End Sub
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Sounds like it can't find "Changed" anywhere on the active sheet.
If you are trying to find those 3 values in row 1 of the invoice dates sheets then you need to remove the word Cells in front of Find but leave the . like
Code:
Set Rng1 = .Find(What:=FS1, _
 
Upvote 0
Forgot to mention that you will also need to remove this line from each of the finds
Code:
after:=Cells(1, 1), _
so that you end up with
Code:
    Set Rng1 = .Find(What:=FS1, _
                    LookAt:=xlWhole, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
 
Upvote 0
You're welcome & thanks for the feedback
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

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