What's happening is the code is looking for an identical match between the cell in column A and the cell in column D.

If you replace the For Each rCell section with the below which replaces the If-Then function with the Replace function:

'''look in each cell in range
For Each rCell In sht.Range("d1:d20").Cells
'''if the cell's value is equal to sFind then change its value to sReplace
rCell.Value = Replace(rCell.Value, sFind, sReplace)
'''continue onto next cell and repeat above
Next rCell

it will search the column D text and replace 'Dog' wherever finds it - that should solve the issue you've found.

One caveat is that it will literally replace the text wherever it finds it so it will change dog to cat but it will also for example change dogma to catma. If that's a problem you could write something to check if there are spaces before and after the word before replacing it. The in string (InStr) function could probably be used for that.