How to apply "found" Macro - excel

Question

I have three macros that compare two columns
The one I am using is vary slow on a large file but works
Sub MatchPermissionGiverAndTarget()
Dim LastRow As Long
Dim ws As Excel.Worksheet
GoFast False
Set ws = ActiveWorkbook.Sheets("Helper")
LastRow = ws.Range("A" & ws.Rows.count).End(xlUp).Row
Range("E1").EntireColumn.Insert
Range("E1").FormulaR1C1 = "name"
With ws.Range("E2:E" & LastRow)
.Formula = "=INDEX(B:B,MATCH($D2,$B:$B,0))"
.Value = .Value
End With
Columns("D:D").EntireColumn.Delete
GoFast True
End Sub
And this one I found by #mehow Here: Fast compare method of 2 columns
But I can not figure out how to apply it so it dose what the first one dose
Any help on this is appreciated
Sub Main()
Application.ScreenUpdating = False
Dim stNow As Date
stNow = Now
Dim arr As Variant
arr = Range("B2:A" & Range("B" & Rows.Count).End(xlUp).Row).Value
Range("E1").EntireColumn.Insert
Range("E1").FormulaR1C1 = "name"
Dim varr As Variant
varr = Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row).Value
Dim x, y, match As Boolean
For Each x In arr
match = False
For Each y In varr
If x = y Then match = True
Next y
If Not match Then
Range("D" & Range("D" & Rows.Count).End(xlUp).Row + 1) = x
End If
Next
Columns("D:D").EntireColumn.Delete
Debug.Print DateDiff("s", stNow, Now)
Application.ScreenUpdating = True
End Sub
Or This one from same thread by #Reafidy
Sub HTH()
Application.ScreenUpdating = False
With Range("E2", Cells(Rows.Count, "E").End(xlUp)).Offset(, 1)
.Formula = "=VLOOKUP(B2,D:D,1,FALSE)"
.Value = .Value
.SpecialCells(xlCellTypeConstants, 16).Offset(, -1).Copy Range("D" & Rows.Count).End(xlUp).Offset(1)
.ClearContents
End With
Application.ScreenUpdating = True
End Sub

Answer 1

try this one:
Sub Main()
Dim ws As Worksheet
Dim stNow As Date
Dim lastrow As Long, lastrowB As Long
Dim match As Boolean
Dim k As Long
Dim arr, varr, v, a, res
Application.ScreenUpdating = False
stNow = Now
Set ws = ActiveWorkbook.Sheets("Helper")
With ws
lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
lastrowB = .Range("B" & .Rows.Count).End(xlUp).Row
arr = .Range("B2:B" & lastrowB).Value
varr = .Range("D2:D" & lastrow).Value
.Range("E1").EntireColumn.Insert
.Range("E1").FormulaR1C1 = "name"
End With
k = 1
ReDim res(1 To lastrow, 1 To 1)
For Each v In varr
match = False
'if value from column D (v) contains in column B
For Each a In arr
If a = v Then
match = True
Exit For
End If
Next a
If match Then
res(k, 1) = v
Else
res(k, 1) = CVErr(xlErrNA)
End If
k = k + 1
Next v
With ws
.Range("E2:E" & lastrow).Value = res
.Range("D:D").Delete
End With
Debug.Print DateDiff("s", stNow, Now)
Application.ScreenUpdating = True
End Sub