Combine duplicated rows into one row (And delete the second)

[kostasb40]

Hello,

I m trying for 2 weeks to solve a consolidated problem from 3 excel files and i cannot find duplicated rows and combine in one.

I attach the code with the problematic piece

'With w1
'
'
'For x = erow To 1 Step -1
' For y = 1 To erow
' If w1.Cells(x, 4).Value = w1.Cells(y, 4).Value And x > y Then
'
' w1.Cells(y, 13).Value = w1.Cells(x, 13).Value
' Rows(x).EntireRow.Delete
' Exit For
' End If
' Next y
'Next x
'End With

Unfortunately cannot find the duplicate value based on the d column and therefore i cannot assign later the values from one column and delete the other


Please help me as 2 weeks passed and i cannot find the solution

 

[queuesmef]

1)Look into conditional formatting (you may need to 'move' the columns in question into 1 worksheet or tab.
2) OR Create a pivot table of the data
again my preference would be to move all into one tab.
Without a posted set of data, it's quite difficult to 'see' the problem.
(for #2 above, I assume the data has the same column headings? if so, you could make a 'Helper column' that distinguishes what different files they come from. As example, if all the headings have: CustomerId and Customer Name, then I would and a column for Worksheet. in a blank worksheet I would start with these columns: Worksheet / CustomerId / Customer Name. Perhaps call the tabs from the 3 different excel files: [wks1, wks2, wks3]. Copy the data from the 3 worksheets into the one and fill in the 'Worksheet' file where they came from.
Worksheet / CustomerId / CustomerName
wks1 / Cust01 / alpha
wks1 / Cust05 / Episilan
wks2 / Cust88 / Makr
wks3 / Cust 01 / alpha
...once these are in a pivot, you may be able to spot repeaters (use Count and not sum in the pivot table)

 

[kostasb40]

thanks for your reply

As is seen from the image i would like to combine duplicated rows based on the value of column D (those data are not the real but other in order to describe the problem.

i attach all the code ---


MsgBox "!!!Please select the census with the relevant info!!!"
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
.Show

If (.SelectedItems.Count = 0) Then
End
Else
fullpath = .SelectedItems.Item(1)
Workbooks.Open FileName:=fullpath, UpdateLinks:=0, ReadOnly:=False, Password:="XX"
fullpath = .SelectedItems.Item(2)
Workbooks.Open FileName:=fullpath, UpdateLinks:=0, ReadOnly:=False, Password:="XX"
fullpath = .SelectedItems.Item(3)
Workbooks.Open FileName:=fullpath, UpdateLinks:=0, ReadOnly:=False, Password:="XX"
End If
End With


'define and create all necessary workbooks

'Dim wbcen As Workbook
'Set wbcen = ActiveWorkbook
Dim w1, w2, w3, w4 As Worksheet
Dim c As Range, a As Range
Dim erow As Long
Dim totalrows As Long
Dim Row As Long
Dim lastrow As Long
Dim x As Long
Dim y As Long






Dim master, slave1, slave2, slave3 As Workbook
Set master = ActiveWorkbook

Set w1 = Workbooks("XXX_SUM.xlsm").Worksheets("registry")


Set w2 = Workbooks("XXX_GR.xlsm").Worksheets("registry")
Set w3 = Workbooks("XXX_EN.xlsm").Worksheets("registry")
Set w4 = Workbooks("XXX_ICC.xlsm").Worksheets("registry")




w2.Range("A3:BL100" & w2.Range("A" & Rows.Count).End(xlUp).Row).Copy
w1.Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 2).PasteSpecial Paste:=xlPasteValues


erow = w1.Columns("A").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row


w3.Range("A3:BL100" & w3.Range("A" & Rows.Count).End(xlUp).Row).Copy
w1.Range("A" & erow + 1).PasteSpecial Paste:=xlPasteValues



erow = w1.Columns("A").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row

w4.Range("A3:BL100" & w3.Range("A" & Rows.Count).End(xlUp).Row).Copy
w1.Range("A" & erow + 1).PasteSpecial Paste:=xlPasteValues
w1.Range("A3:BL100").Sort Key1:=w1.Range("D3"), _
Order1:=xlAscending, _
Orientation:=xlSortColumns, _
Header:=xlYes

'========================================================================
FROM HERE IS THE PROBLEM

I CANNOT FIND THE DUPLICATE BASED ON THE COLUMN D IN ORDER TO COMBINE THE DUPLICATE ROWS IN ONE AND DELETE THE OTHER
End With
'

WHY THE CODE DOES NOT CAPTURE THE DUPLICATE VALUE BASED ON THE COLUMN D??



'With w1
''
''
'For x = erow To 3 Step -1
' For y = 3 To erow
' If w1.Cells(x, 4).Value = w1.Cells(y, 4).Value And x > y Then
'
' w1.Cells(y, 13).Value = w1.Cells(x, 13).Value
' Rows(x).EntireRow.Delete
' Exit For
' End If
' Next y
'Next x
'End With
''========================================================================



'========================================================================




'
MsgBox "Done!"