PDA

View Full Version : help with dynamic offset



zouhair_psi
03-13-2017, 08:59 AM
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
03-13-2017, 11:35 AM
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
03-13-2017, 11:48 AM
thx for your time .

i did try it , but nothing happened

mdmackillop
03-13-2017, 12:04 PM
Workbook attached

zouhair_psi
03-13-2017, 12:08 PM
this what i want exactly

thank you for your knowledge and time.

zouhair_psi
03-13-2017, 12:20 PM
one more think .

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

zouhair_psi
03-13-2017, 12:35 PM
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
03-13-2017, 12:42 PM
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
03-13-2017, 12:56 PM
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
03-13-2017, 01:09 PM
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
03-13-2017, 01:53 PM
i forgot to mention , that i compare the cells in the last row with the cells in rows above it.

mdmackillop
03-14-2017, 03:38 AM
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
03-14-2017, 06:03 AM
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.