Hi,

The reason this runs on the entire column is because the macro is looking at every cell down column D. Assuming column D has no data, this would place the last row at the bottom of the sheet. Just change the rng2 argument to this:

Set rng2 = Range("D2:D" & Range("A" & Rows.Count).End(xlUp).Row)

The rest of the macro seemed to work fine on my machine.

Ben