Read all column cells if data available and skip empty cells using macro - excel

Question

I have a macro that reads two xls sheets that compares the data and copy the match into the next column. But the only problem with my code is if is there any empty cell comes in between it stops thinking that it is the end of the file. I have a scenario where I have some blank cells in the column which I need to read and may be data is available in next row.
macro file:
Sub findAndReplace()
'Declare working sheet objects
Dim rSh1 As Range, rSh2 As Range, rFound As Range, r As Range
Dim strShortName As String
strShortName = Cells(2, 3)
'Check if the source file is opened or not, if not open it
checkFileOpened (strShortName)
'Read the source file for mapping
With Workbooks(strShortName).Worksheets("sheet1")
Set rSh1 = .Range("B2", .Range("B2").End(xlDown))
End With
'Read the current working sheet for given range to match with source data
With Worksheets("sheet1")
Set rSh2 = .Columns("A:a")
End With
'Loop through for a match and replace it
For Each r In rSh1
With r
Set rFound = rSh2.Find(what:=.Value, lookat:=xlWhole)
If Not rFound Is Nothing Then
.Offset(0, 1) = rFound.Offset(0, 1).Value
Else
.Offset(0, 1) = "Not Found"
End If
End With
Next r
End Sub

Answer 1

Try replacing Set rSh1 = .Range("B2", .Range("B2").End(xlDown)) with Set rSh1 = Range(.Cells(2,2), .Cells(rows.Count,2).End(xlUp)). I don't see any logic to skip a blank cell (r). You may want to add that, too.
Sub findAndReplace()
'Declare working sheet objects
Dim rSh1 As Range, rSh2 As Range, rFound As Range, r As Range
Dim strShortName As String
strShortName = Cells(2, 3)
'Check if the source file is opened or not, if not open it
checkFileOpened (strShortName)
'Read the source file for mapping
With Workbooks(strShortName).Worksheets("sheet1")
Set rSh1 = Range(.Cells(2,2), .Cells(rows.Count,2).End(xlUp))
End With
'Read the current working sheet for given range to match with source data
With Worksheets("sheet1")
Set rSh2 = .Columns("A:a")
End With
'Loop through for a match and replace it
For Each r In rSh1
If Not r is Nothing
Set rFound = rSh2.Find(what:=.Value, lookat:=xlWhole)
If Not rFound Is Nothing Then
r.Offset(0, 1) = rFound.Offset(0, 1).Value
Else
r.Offset(0, 1) = "Not Found"
End If
End If
Next r
End Sub

Answer 2

So I did a little modification to the answer given by #Brian and here is my working solution
Sub findAndReplace()
'Declare working sheet objects
Dim rSh1 As Range, rSh2 As Range, rFound As Range, r As Range
Dim strShortName As String
strShortName = Cells(2, 3)
'Check if the source file is opened or not, if not open it
checkFileOpened (strShortName)
'Read the source file for mapping
With Workbooks(strShortName).Worksheets("sheet1")
Set LastCellB = .Cells(.Rows.Count, "B").End(xlUp)
Set rSh1 = .range("B2", LastCellB)
End With
'Read the current working sheet for given range to match with source data
With Worksheets("sheet1")
Set rSh2 = .Columns("A:a")
End With
'Loop through for a match and replace it
For Each r In rSh1
With r
Set rFound = rSh2.Find(What:=.Value, LookAt:=xlWhole)
If Not rFound Is Nothing Then
.Offset(0, 1) = rFound.Offset(0, 1).Value
Else
.Offset(0, 1) = "Not Found"
End If
End With
Next r
End Sub