Delete Dublicates in each rows

[baha17]

Dear All,
I have a certain data in over 2000 rows. There are staff numbers on column J to column AA in row. But sometimes the same staff numbers are dublicated in the same row different column. That is my problem. I tried to remove dublicated staff numbers from each row but could not really figure out how. As far as I notice, excel 2007 only provides removing dublicates from each column. but that is not what I need. Is there any way to remove dublicated items from each rows? For example; staff number 123456 can be in J4,M4,P4 and AA4 i want to remove the dublicated items from row 4. I do not want to remove if it is dublicated on the same column such J6 or AA8. Because each rows represants different locations.
Thanks for the help
Baha

 

[liveinhope]

There's probably a better way to do this via VBA but if this is a one-off or sometihng you only do occasionally you could do this by

MAKE A COPY OF THE ORIGINAL SHEET FIRST

step1 - copy-and paste-special all 2,000+ rows , all used columns to another worksheet use the special "transpose" option
step 2 - now that the duplicates are spread out over multiple rows rather than multiple columns remove the duplicates
step 3- clear the original worksheet
step 4 - copy-and -paste the duplicate-free data back to this sheet ; once again use the transpose option

 

[baha17]

Hi Liveinhope,

First of all thank you very much for your answer. That was what I thought at first.But to do that I need a 2000 columns.However, maybe i do that with a macro one by one. I was hoping there might be another way.
Thank you very much for the idea.
Baha

 

[liveinhope]

I'm working on a macro - not quite finished
watch this space

 

[baha17]

Thanks liveinhope,
I wrote a code after your suggestion:

Sub DeletingDubsFromRows()
Dim cel As Range
Dim LastRow As Long
Dim LastRow2 As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
LastRow = Sheets("DropVar").Range("A" & Sheets("DropVar").Rows.Count).End(xlUp).Row
For Each cel In Sheets("DropVar").Range("A4:A" & LastRow)
If cel <> "" Then
Sheets("Convert").Columns("A:A").ClearContents
Range("J" & cel.Row & ":AK" & cel.Row).Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Sheets("Convert").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Columns("A:A").Select
Application.CutCopyMode = False
LastRow2 = Sheets("Convert").Range("A" & Sheets("Convert").Rows.Count).End(xlUp).Row + 1

ActiveSheet.Range("A1:A" & LastRow2).RemoveDuplicates Columns:=1, Header:=xlNo
LastRow2 = Sheets("Convert").Range("A" & Sheets("Convert").Rows.Count).End(xlUp).Row + 1
Range("A1:A" & LastRow2).Select
Selection.Copy
Sheets("DropVar").Select
cel.Offset(0, 9).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End If
Next cel


End Sub

it worked very well thanks for the input.
have a good day.
baha

 

[liveinhope]

and here's my macro - looks for and removes duplicates on row2 to last row where more than one columns from J (firstcol = 10 onwards is a duplicate
I'm going to look at your code too because it 's doing the sasme thing but in a different way
- for example you use 2 worksheets and copy/paste ; mine uses only a single sheet.


Sub remove_dups_all_rows()
Dim last_row As Integer
Dim row_to_check As Integer
Dim first_column As Integer
Dim last_column As Integer
Dim col_to_check As Integer
Dim col_to_match As Integer
Dim match_value As Variant
Dim value_to_check As Variant
Dim match_found As Boolean
Application.ScreenUpdating = False
first_column = 10
last_row = ActiveSheet.Cells(Rows.count, "a").End(xlUp).Row

For row_to_check = 2 To last_row
last_column = ActiveSheet.Cells(row_to_check, Columns.count).End(xlToLeft).Column
For col_to_check = last_column To first_column + 1 Step -1

value_to_check = Cells(row_to_check, col_to_check).Value
match_found = 0
col_to_match = col_to_check - 1
Do While col_to_match >= first_column And Not (match_found)
match_value = Cells(row_to_check, col_to_match).Value
If match_value = value_to_check Then
Cells(row_to_check, col_to_match).Select
Selection.Delete Shift:=xlToLeft
match_found = 1
End If

col_to_match = col_to_match - 1
Loop
Next col_to_check
Next row_to_check
ScreenUpdating = True
End Sub

 

[baha17]

Wow you rock "liveinhope".
It works very fine and fast compare to mine
I like the style.
Thanks
Baha

 

[liveinhope]

ure welcome