VBA - remove duplicates using range and cells functions together

[sdelan]

Hello,
My objective: Delete specific range based on duplicates in a specific column , and shift cells up.
I have a large spreadsheet with evenly separated data. I have an example attached of the outcome I want, but I would like to have it in a loop, where the script counts the columns and re-runs.
I am also wondering, can any one of these be referenced to eachother -> for example can TonyRange = ("E2:G") be referenced using a Cells function... or can I vice versa. I have multiple situations in other code where for example I need to identify ("E1:E10") as a range, but I want to do so using the Cells function


I suspect there is a much easier way to do this, but I am very new with VBA and this is what I could come up with. This is only for 2 individuals, I have about 30
I have also attached images of before and after.


Code:

Sub RemoveDuplicates ()
Dim TonyRangeColumn As Integer
Dim NickRangeColumn As Integer
Dim TonyRange As Variant
Dim NickRange As Variant

TonyRangeColumn = 4
NickRangeColumn = 12

TonyRange = ("E2:G")
NickRange = ("M2:O")

ws.Range(TonyRange & (Cells(Rows.Count, TonyRangeColumn).End(xlUp).Row)).RemoveDuplicates Columns:=1
ws.Range(NickRange & (Cells(Rows.Count, NickRangeColumn ).End(xlUp).Row)).RemoveDuplicates Columns:=1


End Sub

 

[Anthony47]

If Tony's block is clearly separated by Nick's one then we could use CurrentRange to refer to a block.
For example:

Sub Remover()
Dim iBlk As String, Dist As Long, I As Long
'
iBlk = "A1"             '<<< The initial coordinates of the first block
Dist = 8                '<<< The columns from first to second block
'
For I = 1 To 100 * Dist Step Dist          'Max 100 blocks
    Debug.Print Range(iBlk).Cells(1, I).CurrentRegion.Address(0, 0)
    If Range(iBlk).Cells(1, I).Value = "" Then Exit For
    Range(iBlk).Cells(1, I).CurrentRegion.RemoveDuplicates Columns:=1
Next I
End Sub

The rows marked <<< have to be customized according your situation

To be tested on a copy of your workbook

 

[sdelan]

This is what I came up with and it works perfect for anyone that needs something similar. The columns in interest are all the same distance apart

Worksheets("calc").Activate

For c = 5 To 500 Step 8 'loops through every 8th column, starting in column 5, up to the 500th column
Set xrange = Range(Cells(2, c), Cells(1000, c + 2)) 'Cells (2,c) selects first range of row 2 and column E, Cells(1000, c + 2) expands the range to 1000 rows down and 2 columns to the right of column E
xrange.RemoveDuplicates Columns:=1 ' removes duplicates based on first column in range, column E
Next c