if and for loop contained inside while loop VBA - vba

Question

I am attempting to write some code that loops throw a column of data in one column ad matches it with data in another column all in the same sheet. When the two data points are matched the corresponding data will be copied to beside the first data point. The simplest way of putting it is I have a if statement inside a for Staten inside a while loop. I believe the issue is I am either not while looping correctly or I am not assigning the data correctly, either way the script is not writing any data to the columns they or supposed to write to. Any help in getting this script working would be appreciated see code below.
Sub s()
Dim i As Integer
Dim pointer As Integer
pointer = 1
Do While ThisWorkbook.Sheets("MPACSCodesedited").Cells(pointer, 13) <> ""
For i = 1 To 305
If ThisWorkbook.Sheets("MPACSCodesedited").Cells(i, 1).Value =
ThisWorkbook.Sheets("MPACSCodesedited").Cells(pointer, 13).Value Then
ThisWorkbook.Sheets("MPACSCodesedited").Cells(pointer, 14).Value = ThisWorkbook.Sheets("MPACSCodesedited").Cells(i, 2).Value
ThisWorkbook.Sheets("MPACSCodesedited").Cells(pointer, 15).Value = ThisWorkbook.Sheets("MPACSCodesedited").Cells(i, 3).Value
End If
pointer = pointer + 1
Next i
Loop
End Sub

Answer 1

Move pointer = pointer + 1 outside the For Loop
Sub s()
Dim i As Long
Dim pointer As Long
pointer = 1
Do While ThisWorkbook.Sheets("MPACSCodesedited").Cells(pointer, 13) <> ""
For i = 1 To 305
If ThisWorkbook.Sheets("MPACSCodesedited").Cells(i, 1).Value = ThisWorkbook.Sheets("MPACSCodesedited").Cells(pointer, 13).Value Then
ThisWorkbook.Sheets("MPACSCodesedited").Cells(pointer, 14).Value = ThisWorkbook.Sheets("MPACSCodesedited").Cells(i, 2).Value
ThisWorkbook.Sheets("MPACSCodesedited").Cells(pointer, 15).Value = ThisWorkbook.Sheets("MPACSCodesedited").Cells(i, 3).Value
End If
Next i
pointer = pointer + 1
Loop
End Sub
But as stated in my comments using variant arrays will be quicker:
Sub s()
With ThisWorkbook.Worksheets("MPACSCodesedited")
lastrw = .Cells(.Rows.Count, 13).End(xlUp).Row
Dim outarr As Variant
outarr = .Range(.Cells(1, 13), .Cells(.Cells(.Rows.Count, 13).End(xlUp).row,15)).Value
Dim SearchArr As Variant
SearchArr = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count,1).End(xlUp).Row, 3))
Dim i As Long
For i = LBound(outarr, 1) To UBound(outarr, 1)
Dim j As Long
For j = LBound(SearchArr, 1) To UBound(SearchArr, 1)
If SearchArr(j, 1) = outarr(i, 1) Then
outarr(i, 2) = SearchArr(j, 2)
outarr(i, 3) = SearchArr(j, 3)
Exit For
End If
Next j
Next i
.Range(.Cells(1, 13), .Cells(.Rows.Count, 14).End(xlUp)).Value = outarr
End With
End Sub