help with dynamic offset

[zouhair_psi]

hi ,in the attachments a simplified file version with color for what i want to do with vba.

i have the first and principal range with data , A to G (7 column), a second range from I to O (7 column) , third from Q to W (7 column)...
i use this macro to find duplicate and cut destination

For Each Cell In rngData
If Cell <> Empty And _
Cell.Value = ACell.Value And _
Cell.Address <> ACell.Address Then
Cell.ClearContents ' clear duplicated cells in the first row
Acell.cut destination:= Acell.offset(0,8) ' move duplicated cells in the last row

now i have two ranges with data , first range (A to G ) and second range from (I to O). 'sheet T1

with sheet T2 i have duplicated value.

instead of Acell.cut destination:= Acell.offset(0,8) become Acell.cut destination:= Acell.offset(0,16) ' sheet T3

only for duplicated value found in the second range and so on for the third range ...
Acell.offset(0,8) become Acell.offset(0,16) become Acell.offset(0,32)...

i appreciate your help and sorry for my poor english.

[mdmackillop]

Give this a try

Sub MoveDups()
    Dim r As Range, Data As Range, cel As Range, c As Range, tng As Range
    Dim Chk As Boolean
    Set r = Range("A1:G1")
    Set Data = Range(Cells(2, 1), Cells(Rows.Count, 7).End(xlUp))
    For Each cel In r
        Set Rng = Nothing
        Chk = False
        With Data
            Set c = .Find(cel, Lookat:=xlWhole)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    Chk = True
                    If Rng Is Nothing Then
                        Set Rng = c
                    Else
                        Set Rng = Union(Rng, c)
                    End If
                    c.Copy c.Offset(, 8 * (c.Row - 1))
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
        End With
        If Chk Then
            cel.ClearContents
            Rng.ClearContents
        End If
    Next cel
End Sub

[zouhair_psi]

thx for your time .

i did try it , but nothing happened

[mdmackillop]

Workbook attached

[zouhair_psi]

this what i want exactly

thank you for your knowledge and time.

[zouhair_psi]

one more think .

when i add more row to the first range A1:G1 , numbers in range 2 and 3 disappear.

[zouhair_psi]

when i add one row and execute the macro and add another row the macro doesn't work as expected.

if you can fix it plz

[mdmackillop]

Add a check for Cel<>"". Of course the code will not find 26 for example if it appears in Row 5 as it has been cleared from row 1 on the first running.

[zouhair_psi]

here's the original file , if you can add your macro.

and also to have clear idea about what i want to do.

thx

[mdmackillop]

If you need to add more rows and rerun your macro make this change to hide the numbers in row 1, rather than deleting them.

If Chk Then
                cel.NumberFormat = ";;;"
                Rng.ClearContents
            End If

[zouhair_psi]

i forgot to mention , that i compare the cells in the last row with the cells in rows above it.

[mdmackillop]

You need to set R to loop through each row and change Data to suit. All duplicate cells will need the contents hidden rather than deleted as previously posted.

[zouhair_psi]

Thx for yout time and efforts.
After analyzing your macro . I realize that it's not what I look for.
Your macro move duplicated cell in row 2 , to offset (0,8) and cell in row 3 to offset (0,16).
What I need is if any duplicated value found in range A1 to G to the last row at any time then offset by 8 , if any duplicated value found in range 2 from I to o the the last row then offset cell in the first range by 16 .
And so on for the third range .
But at any time a duplicated value found in range 1 then offset by 8.