Delete row if cell is contained within a range

I want a macro to look at column D on sheet 1 from row 2 all the way down to the last used row and if for example column D row X is found in sheet2 column D then delete the entire row in sheet1.

This is your code, you posted it a while back and I happened to comment on that thread. The match function is much faster than the "Find" function. I have tested it and it works.

Sub ColumnSearch()

Dim w1 As Worksheet, w2 As Worksheet, c As Range, fr As Long

Application.ScreenUpdating = False

Set w1 = Worksheets("sheet1")
Set w2 = Worksheets("sheet2")

For Each c In w1.Range("D2", Range("A" & Rows.Count).End(xlUp))

   If Len(c) Then
    fr = 0
    On Error Resume Next
     With w2
        fr = Application.Match(c, .Columns(4), 0)
        On Error GoTo 0
        If fr > 0 Then
        c.EntireRow.Delete
        End If
    End With
  End If
Next c

Application.ScreenUpdating = True
Set w1 = Nothing
Set w2 = Nothing

End Sub

If there is data in column D whatever row it is there will definitely also be data in column A the same row. So would the above fix still apply Mike?

Sorry, It was my mistake, as Mike said you could use

LR = w1.Range("A" & Rows.Count).End(xlUp).Row

For Each c In w1.Range("D2:D" & LR)

This should loop through each cell in D2 all the way down as long as there are data in column A. You could use column D for LR as long as column A and D have the same length.

Last question,

How can I alter it so that when a match is found instead of c.EntireRow.Delete it replaces that cell with the value of the cell directly to the right of where the match was found in sheet2?

Sub ColumnSearch()

Dim w1 As Worksheet, w2 As Worksheet, c As Range, fr As Long

Application.ScreenUpdating = False

Set w1 = Worksheets("sheet1")
Set w2 = Worksheets("sheet2")

For Each c In w1.Range("D2", Range("D" & Rows.Count).End(xlUp))

   If Len(c) Then
    fr = 0
    On Error Resume Next
     With w2
        fr = Application.Match(c, .Columns(4), 0)
        On Error GoTo 0
        If fr > 0 Then
        c.EntireRow.Delete
        End If
    End With
  End If
Next c

Application.ScreenUpdating = True
Set w1 = Nothing
Set w2 = Nothing

End Sub

Would this be along the right lines;

c = fr(offset(0, 1))

The above isn't quite working for me but I think I'm close. So if sheet 1 D5 for example matches sheet2 d55 then I want what is in sheet2 e55 pasted into sheet1 d5

Is the below any closer? It runs without error but doesn't do as intended.

Sub Alter()

    Dim rsht1 As Long, rsht2 As Long
    
    rsht1 = Sheets("Sheet1").Range("A41")
    rsht2 = Sheets("Sheet2").Range("H" & Rows.Count).End(xlUp).Row
    
    For i = 4 To rsht1
        For j = 2 To rsht2
       
            If Sheets("Sheet1").Range("A" & i) = Sheets("Sheet2").Range("H" & j) Then
            
            Sheets("Sheet2").Range("I" & j).Copy
            Sheets("Sheet11").Rows(i).PasteSpecial x1Values
                
            End If
        Next
    Next
         
End Sub

Solved it, just offsetting issues