Excel crashes when comparing two columns VBA macro - vba

Question

I have two columns which I am comparing for identical entries, and pushing the matches to another column through Offset. When I run the macro I've built (off of some Microsoft canned code) it essentially freezes and crashes, since it is a nested for each loop based on cells that are used, I figured it would end upon reaching an empty cell, but I fear I may be in a infinite loop. Any help will be much appreciated.
Dim myRng As Range
Dim lastCell As Long
Dim lastRow As Long
lastRow = ActiveSheet.UsedRange.Rows.Count
Dim c As Range
Dim d As Range
For Each c In Worksheets("Sheet1").Range("AT2:AT" & lastRow).Cells
For Each d In Worksheets("Sheet1").Range("AU2:AU" & lastRow).Cells
If c = d Then c.Offset(0, 1) = c
Next d
Next c

Answer 1

Try this:
Dim lastRow, currentRow, compareRow As Long
Dim found As Boolean
lastRow = Range("AT2").End(xlDown).Row
For currentRow = 2 To lastRow
compareRow = 2
found = False
Do While compareRow <= lastRow And Not found
If Range("AT" & currentRow).Value = Range("AU" & compareRow).Value Then
found = True
Range("AV" & currentRow).Value = Range("AT" & currentRow).Value
End If
compareRow = compareRow + 1
DoEvents
Loop
Next currentRow
Rather than selecting ranges and then cycling through them, this does the same thing without needing to .Select anything. It also breaks out of the inner loop early if it finds a match.

Answer 2

I believe that there are multiple issues here:
Efficiency of the search method
Loss of responsiveness of Excel
You can dramatically improve the efficiency of the code if you can pull all values into arrays. This prevents the time spent by VBA in accessing the Excel Object model and back. Loss of responsiveness can be handled by using DoEvents. Try the code below. It may look longish but should be easy to understand.
'Find last row
Dim lastRow As Variant
lastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
'Create dynamic arrays
Dim AT() As Variant: Dim AU() As Variant: Dim AV() As Variant
ReDim AT(2 To lastRow): ReDim AU(2 To lastRow): ReDim AV(2 To lastRow)
'Get all contents from Excel
For i = 2 To lastRow
AT(i) = Worksheets("Sheet1").Cells(i, 46)
AU(i) = Worksheets("Sheet1").Cells(i, 47)
Next i
'Do the comparison
For c = 2 To lastRow
For d = 2 To lastRow
If AT(c) = AU(d) Then AV(c) = AT(c)
Next d
'Allow a brief breather to Excel once in a while (don't hang)
If (c / 100) = Int(c / 100) Then DoEvents
Next c
'Place final contents to Excel
For i = 2 To lastRow
Worksheets("Sheet1").Cells(i, 48) = AV(i)
Next i

Answer 3

Try this for your loop:
Dim StartRange As Range, j As Long
Dim CompareRange As Range, i As Range
With Worksheets("Sheet1")
Set StartRange = .Range("AT1", .Range("AT:AT").Find("*", , , , xlByRows, xlPrevious))
Set CompareRange = .Range("AU1", .Range("AU:AU").Find("*", , , , xlByRows, xlPrevious))
For Each i In StartRange
i.Offset(, -8).Value = .Evaluate("IF(COUNTIF(" & CompareRange.Address(0, 0) & "," & i.Address(0, 0) & ")>0," & i.Value & ","""")")
Next i
End With

Answer 4

Dim CompareRange As Variant, To_Be_Compared As Variant, j As Variant, k As Variant
Range("AT2").Select
Selection.End(xlDown).Select
Set To_Be_Compared = Range("AT2:" & Selection.Address)
Range("AU2").Select
Selection.End(xlDown).Select
Set CompareRange = Range("AU2:" & Selection.Address)
To_Be_Compared.Select
For Each j In Selection
DoEvents
For Each k In CompareRange
If j = k Then j.Offset(0, 2) = j
Next k
Next j

Answer 5

I finally got it to work, after taking the suggestions and implementing them into my code, I was able to see where the mistake actually was, I was referencing the wrong column earlier in the code and through this, created no duplicate entries to match, so after fixing this, the matches now appear, I ended up offsetting them, and changing the value to "yes" to reflect the duplication in my chart.
Thank you all for the help.