Kan Range niet veranderen VBA code

[ROSO]

Met de volgende voorbeeldmacro worden twee lijsten met elkaar vergeleken en worden items in de tweede lijst verwijderd als ze ook in de eerste lijst (de hoofdlijst) staan. De eerste lijst staat op Blad1 in het bereik A1:A10. De tweede lijst staat op Blad2 in het bereik A1:A100. Je kan de macro gebruiken door een van de beide werkbladen te selecteren en de macro uit te voeren.

Nu probeer ik de range de verander bv A1:A10 in D110 maar dat doe ie niets.
Hebben jullie misschien een oplossing voor mij?????????

Sub DelDups_TwoLists()
Dim iListCount As Integer
Dim iCtr As Integer

' Turn off screen updating to speed up macro.
Application.ScreenUpdating = False

' Get count of records to search through (list that will be deleted).
iListCount = Sheets("sheet2").Range("D1:D100").Rows.Count

' Loop through the "master" list.
For Each x In Sheets("Sheet1").Range("D2:D10")
' Loop through all records in the second list.
For iCtr = 1 To iListCount
' Do comparison of next record.
' To specify a different column, change 1 to the column number.
If x.Value = Sheets("Sheet2").Cells(iCtr, 1).Value Then
' If match is true then delete row.
Sheets("Sheet2").Cells(iCtr, 1).Delete xlShiftUp
' Increment counter to account for deleted row.
iCtr = iCtr + 1
End If
Next iCtr
Next
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub

 

[snb]

Sub DelDups_TwoLists()
  Application.ScreenUpdating = False
  c0 = "|" & Join(WorksheetFunction.Transpose(Sheets("Blad2").Range("A1:A100")), "|") & "|"
  With Sheets("Blad1").Range("D2:D10")
    sq = .offset

    For j = 1 To UBound(sq)
       If InStr(c0, "|" & sq(j, 1) & "|") > 0 Then sq(j, 1) = ""
    Next
    .offset = sq
    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  End With
  Application.ScreenUpdating = True
End Sub

 

[Wigi]

Je moet dan uiteraard ook wel overal alles aanpassen

O.a. kolom 1 (A) veranderen naar kolom 4 (D).

Wigi

 

[ROSO]

Sub DelDups_TwoLists()
  Application.ScreenUpdating = False
  c0 = "|" & Join(WorksheetFunction.Transpose(Sheets("Blad2").Range("A1:A100")), "|") & "|"
  With Sheets("Blad1").Range("D2:D10")
    sq = .offset

    For j = 1 To UBound(sq)
       If InStr(c0, "|" & sq(j, 1) & "|") > 0 Then sq(j, 1) = ""
    Next
    .offset = sq
    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  End With
  Application.ScreenUpdating = True
End Sub

 

[ROSO]

Code werkt

:thumb: Bedankt snb en wigi