Delete Duplicates and Concatenate Based on Date

[nrobbins]

Hi Guys,

I'm kind of new to this... can anybody help me? I've tried reading the other sort-concat threads on here, but I was unable to apply them to my own needs.

Basically, I get a bunch of data dumped into excel with a date and a description. There's always a date in Column A, and a description in Column B. Sometimes, there are multiple duplicates in Column B for each day.

I need to produce vba that will:


-delete duplicates based on date (column A)
-concatenate text strings based on date (for each day of the month, or each day that is present in column A)


Any ideas would be much appreciated.

Thanks!

 

[ziad alsayed]

i will suggest the below, it works for me.
sort by column B , you will have the duplicate under each other
if you want to remove both use the below and amend to your needs

'find final row
finalrow= wss.cells(rows.count,1).end(xlup).row
'sort
    wss.Sort.SortFields.Add Key:=Range("B2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With wss.Sort
        .SetRange Range("B1:B1000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
' delete duplicates
For C = finalsummaryrow To 2 Step -1
        If Cells(C, 7) = Cells(C - 1, 7) Then
            Cells(C, 1).EntireRow.Delete
            Cells(C - 1, 1).EntireRow.Delete
        End If
    Next C
' use the below to concatenate A1 to B1
Selection.FormulaR1C1 = "=RC[-2]& "" "" & RC[-1]"

hope this will help

 

[nrobbins]

Thanks for the help! I'm getting a compile error at this line:

finalrow = wss.Cells(Rows.Count, 1).End(xlUp).Row

It's telling me "object required".

Any ideas?

 

[ziad alsayed]

Instead of wss put your worksheet name as
worksheets("sheets1") for example

 

[nrobbins]

Hi Ziad,

I'm still having trouble with the following - perhaps it's the syntax that I don't understand.

Sub SortConcat()
'find final row
finalrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
'sort
Sheet1.Sort.SortFields.Add Key:=Range("B2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Sheet1.Sort
.SetRange Range("B1:B10000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' delete duplicates
For c = finalsummaryrow To 2 Step -1
If Cells(c, 7) = Cells(c - 1, 7) Then
Cells(c, 1).EntireRow.Delete
Cells(c - 1, 1).EntireRow.Delete
End If
Next c
' use the below to concatenate A1 to B1
Selection.FormulaR1C1 = "=RC[-2]& "" "" & RC[-1]"
End Sub

 

[nrobbins]

Actually,

I misread your post - I apologize.

I am still getting an error on this line, though (438 - object doesn't support property or method)


Sub Sort()

'find final row
finalrow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
'sort
Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Worksheets("Sheet1").Sort
.SetRange Range("B1:B1000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' delete duplicates
For c = finalsummaryrow To 2 Step -1
If Cells(c, 7) = Cells(c - 1, 7) Then
Cells(c, 1).EntireRow.Delete
Cells(c - 1, 1).EntireRow.Delete
End If
Next c
' use the below to concatenate A1 to B1
Selection.FormulaR1C1 = "=RC[-2]& "" "" & RC[-1]"
End Sub

 

[ziad alsayed]

Dear robbins

try the below

finalrow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("B2:A1000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
  ' delete duplicate
  For c = finalrow To 2 Step -1
If Cells(c, 2) = Cells(c - 1, 2) Then
Cells(c, 1).EntireRow.Delete
Cells(c - 1, 1).EntireRow.Delete
End If
Next c
End Sub

if you have any queation dont hesitate to reply me agaim

 

[nrobbins]

Hi Ziad,

I am still getting a compile error at the following line:

ActiveWorkbook.Worksheets("Sheet1").sort.SortFields.Clear

Error 438.

I have tried using this vba in different workbooks as well.


Thanks for the help,

Nick

 

[nrobbins]

Ziad - Should I be using something in particular as the "sub" or macro's name?


Thanks,

Nick

 

[nrobbins]

Hi Ziad,


Any ideas? I am still having trouble.


Thanks,


Nick