Optimize slow VBA code - excel

Question

I have the following code - most of which was recorded with the macro recorder. It is slow and seems to be kind of unreliable (sometimes it takes about 1 minute and other times it takes much longer).
I am wondering if anyone here can help me clean this up and get it to run more efficiently.
Thanks!
Sub RemainingMIUL()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Sheets("Sheet2").Select
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Sheet1").Select
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
("L1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("L:L").Select
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("Sheet2").Select
Range("B2").Select
Dim cell As Range
For Each cell In Range("B2", Cells(Rows.Count, "B").End(xlUp))
If Range("A:A").Find(What:=cell.Value2, LookAt:=xlWhole) Is Nothing Then cell.Interior.Color = vbYellow
Next cell
With Sheets("Sheet2")
For Each cell In .Range("B2", Cells(Rows.Count, "B").End(xlUp))
If .Range("A:A").Find(What:=cell.Value2, LookAt:=xlWhole) Is Nothing Then _
Intersect(.UsedRange, cell.EntireRow).Offset(, 1).Copy _
Sheets("Sheet1").Cells(Rows.Count, "L").End(xlUp).Offset(1)
Next cell
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub

Answer 1

Try combining the 2 for loops that you have at the bottom of the code. They both loop through the column B and run code when the same criteria is met.
With Sheets("Sheet2")
For Each cell In .Range("B2", Cells(Rows.Count, "B").End(xlUp))
If .Range("A:A").Find(What:=cell.Value2, LookAt:=xlWhole) Is Nothing Then
Intersect(.UsedRange, cell.EntireRow).Offset(, 1).Copy Sheets("Sheet1").Cells(Rows.Count, "L").End(xlUp).Offset(1)
cell.Interior.Color = vbYellow
End if
Next cell
End With
You can then delete the first loop
For Each cell In Range("B2", Cells(Rows.Count, "B").End(xlUp))
If Range("A:A").Find(What:=cell.Value2, LookAt:=xlWhole) Is Nothing Then cell.Interior.Color = vbYellow
Next cell