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