I'm getting runtime error 91 when trying to run this code. The code is designed to compare two columns with another set of columns in another work book and then return the results from a third column if there is a match.
VBA code
Sub InsertDeviceName_NewBook()
Dim w1 As Worksheet, w2 As Worksheet, wsnew As Worksheet
Dim wbnew As Workbook
Dim c As Range, FR As Variant
Dim d As Range
Dim e As Range, rng1 As Range, rng2 As Range
Dim lr1 As Long, lr2 As Long
Application.ScreenUpdating = False
Set w2 = Workbooks("Book2.xlsx").ActiveSheet
Set w1 = Workbooks("Book1.xlsx").ActiveSheet
w1.Range("B:D").Copy
Set wbnew = Workbooks.Add
Columns("A:A").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Name = w1.Name
Set wsnew = wbnew.ActiveSheet
lr1 = wsnew.Cells(Rows.count, 1).End(xlUp).Row
lr2 = w2.Cells(Rows.count, 1).End(xlUp).Row
wsnew.Range("$B:$C").RemoveDuplicates Columns:=Array(1), _
Header:=xlNo
wsnew.Sort.SortFields.Add2 Key:=Range("B1"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With wsnew.Sort
.SetRange Range("A1:C" & lr1)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
Columns("B:B").Insert Shift:=xlToRight, _
CopyOrigin:=xlFormatFromLeftOrAbove 'or xlFormatFromRightOrBelow
Range("B1").Select
ActiveCell.FormulaR1C1 = "Device Name"
Dim lr3 As Long
lr3 = wsnew.Cells(Rows.count, 1).End(xlUp).Row
rng1 = wsnew.Range("C2:D" & lr3) '''causes error
rng2 = w2.Range("C2:D" & lr2)
For Each d In rng3
FR = Application.Match(d, rng2)
If IsNumeric(FR) Then
d.Offset(, -1).Value = w2.Range("B" & FR).Value
End If
Next d
Range("E1").Select
ActiveCell.FormulaR1C1 = "State"
For Each e In wbnew.Sheets(1).Range("C2", wbnew.Sheets(1).Range("C" & Rows.count).End(xlUp))
FR = Application.Match(e, w1.Columns("C"), 0)
If IsNumeric(FR) Then
e.Offset(, 2).Value = w1.Range("K" & FR).Value
End If
Next e
Dim wkSt As String
Dim wkBk As Worksheet
wkSt = ActiveSheet.Name
For Each wkBk In ActiveWorkbook.Worksheets
On Error Resume Next
wkBk.Activate
Cells.EntireColumn.AutoFit
Next wkBk
Sheets(wkSt).Select
End With
Range("A1:E1").Select
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
Application.ScreenUpdating = True
End Sub
VBA code
Sub InsertDeviceName_NewBook()
Dim w1 As Worksheet, w2 As Worksheet, wsnew As Worksheet
Dim wbnew As Workbook
Dim c As Range, FR As Variant
Dim d As Range
Dim e As Range, rng1 As Range, rng2 As Range
Dim lr1 As Long, lr2 As Long
Application.ScreenUpdating = False
Set w2 = Workbooks("Book2.xlsx").ActiveSheet
Set w1 = Workbooks("Book1.xlsx").ActiveSheet
w1.Range("B:D").Copy
Set wbnew = Workbooks.Add
Columns("A:A").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Name = w1.Name
Set wsnew = wbnew.ActiveSheet
lr1 = wsnew.Cells(Rows.count, 1).End(xlUp).Row
lr2 = w2.Cells(Rows.count, 1).End(xlUp).Row
wsnew.Range("$B:$C").RemoveDuplicates Columns:=Array(1), _
Header:=xlNo
wsnew.Sort.SortFields.Add2 Key:=Range("B1"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With wsnew.Sort
.SetRange Range("A1:C" & lr1)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
Columns("B:B").Insert Shift:=xlToRight, _
CopyOrigin:=xlFormatFromLeftOrAbove 'or xlFormatFromRightOrBelow
Range("B1").Select
ActiveCell.FormulaR1C1 = "Device Name"
Dim lr3 As Long
lr3 = wsnew.Cells(Rows.count, 1).End(xlUp).Row
rng1 = wsnew.Range("C2:D" & lr3) '''causes error
rng2 = w2.Range("C2:D" & lr2)
For Each d In rng3
FR = Application.Match(d, rng2)
If IsNumeric(FR) Then
d.Offset(, -1).Value = w2.Range("B" & FR).Value
End If
Next d
Range("E1").Select
ActiveCell.FormulaR1C1 = "State"
For Each e In wbnew.Sheets(1).Range("C2", wbnew.Sheets(1).Range("C" & Rows.count).End(xlUp))
FR = Application.Match(e, w1.Columns("C"), 0)
If IsNumeric(FR) Then
e.Offset(, 2).Value = w1.Range("K" & FR).Value
End If
Next e
Dim wkSt As String
Dim wkBk As Worksheet
wkSt = ActiveSheet.Name
For Each wkBk In ActiveWorkbook.Worksheets
On Error Resume Next
wkBk.Activate
Cells.EntireColumn.AutoFit
Next wkBk
Sheets(wkSt).Select
End With
Range("A1:E1").Select
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
Application.ScreenUpdating = True
End Sub