VBA to concatenate all cells of the same date and agent with breaks

G

GMLee

New Member
Joined
Jul 23, 2012
Messages
21
Excel 2007
Windows XP


Hello! I currently have a set of data for the activities of agents for up to 6 weeks of dates. Right now each activity is on its own row. I would like to have only one row for each agent for each date and combine all the activities in on cell with a break after each activity.

This is how the data currently appears:
ABCD
1Job TitleNameDateActivity
2JobTitle1Agent18/5/2012Phone 09:30-10:37
3JobTitle1Agent18/5/2012FDR 10:37-10:57
4JobTitle1Agent18/5/2012Phone 10:57-12:00
5JobTitle1Agent18/5/2012Break 12:00-12:15
6JobTitle1Agent18/5/2012Phone 12:15-13:06
7JobTitle1Agent18/5/2012FDR 13:06-13:31
8JobTitle1Agent18/5/2012Phone 13:31-14:00
9JobTitle1Agent18/5/2012Lunch 14:00-14:30
10JobTitle1Agent18/5/2012FDR 14:30-16:15
11JobTitle1Agent18/5/2012Break 16:15-16:30
12JobTitle1Agent18/5/2012FDR 16:30-17:45
13JobTitle1Agent18/5/2012Break 17:45-18:00
14JobTitle1Agent18/5/2012FDR 18:00-20:00
15JobTitle1Agent18/6/2012Technical Difficulty 09:30-10:10
16JobTitle1Agent18/6/2012Phone 10:10-10:45
17JobTitle1Agent18/6/2012Break 10:45-11:00
18JobTitle1Agent18/6/2012Phone 11:00-14:15
19JobTitle1Agent18/6/2012Lunch 14:15-14:45
20JobTitle1Agent18/6/2012Phone 14:45-16:45
21JobTitle1Agent18/6/2012Break 16:45-17:00
22JobTitle1Agent18/6/2012Phone 17:00-18:45
23JobTitle1Agent18/6/2012Break 18:45-19:00
24JobTitle1Agent18/6/2012Phone 19:00-20:00
25JobTitle1Agent18/7/2012Phone 09:30-11:30
26JobTitle1Agent18/7/2012Break 11:30-11:45
27JobTitle1Agent18/7/2012Phone 11:45-13:00
28JobTitle1Agent18/7/2012Lunch 13:00-13:30
29JobTitle1Agent18/7/2012Phone 13:30-16:00
30JobTitle1Agent18/7/2012Break 16:00-16:15
31JobTitle1Agent18/7/2012Phone 16:15-18:15
32JobTitle1Agent18/7/2012Break 18:15-18:30
33JobTitle1Agent18/7/2012Phone 18:30-20:00
34JobTitle1Agent18/8/2012FDR 09:30-11:15
35JobTitle1Agent18/8/2012Break 11:15-11:30
36JobTitle1Agent18/8/2012FDR 11:30-13:30
37JobTitle1Agent18/8/2012Lunch 13:30-14:00
38JobTitle1Agent18/8/2012FDR 14:00-15:30
39JobTitle1Agent18/8/2012Break 15:30-15:45
40JobTitle1Agent18/8/2012FDR 15:45-18:00
41JobTitle1Agent18/8/2012Break 18:00-18:15
42JobTitle1Agent18/8/2012Phone 18:15-20:00
43JobTitle1Agent18/9/2012Phone 11:00-14:00
44JobTitle3Agent28/7/2012PTO 12:30-14:15
45JobTitle3Agent28/7/2012PTO 14:15-14:30
46JobTitle3Agent28/7/2012PTO 14:30-16:15
47JobTitle3Agent28/7/2012PTO 16:15-16:45
48JobTitle3Agent28/7/2012PTO 16:45-18:30
49JobTitle3Agent28/7/2012PTO 18:30-18:45
50JobTitle3Agent28/7/2012PTO 18:45-20:45
51JobTitle3Agent28/7/2012PTO 20:45-21:00
52JobTitle3Agent28/7/2012PTO 21:00-23:00
53JobTitle3Agent28/9/2012Phone 12:30-13:45
54JobTitle3Agent28/9/2012Break 13:45-14:00
55JobTitle3Agent28/9/2012Phone 14:00-17:15
56JobTitle3Agent28/9/2012Lunch 17:15-17:45
57JobTitle3Agent28/9/2012Phone 17:45-19:00
58JobTitle3Agent28/9/2012Break 19:00-19:15
59JobTitle3Agent28/9/2012Phone 19:15-20:45
60JobTitle3Agent28/9/2012Break 20:45-21:00
61JobTitle3Agent28/9/2012Phone 21:00-23:00
62JobTitle3Agent28/10/2012Phone 08:30-09:45
63JobTitle3Agent28/10/2012Break 09:45-10:00
64JobTitle3Agent28/10/2012Phone 10:00-12:30
65JobTitle3Agent28/10/2012Lunch 12:30-13:00
66JobTitle3Agent28/10/2012Phone 13:00-14:45
67JobTitle3Agent28/10/2012Break 14:45-15:00
68JobTitle3Agent28/10/2012Phone 15:00-17:15
69JobTitle3Agent28/10/2012Break 17:15-17:30
70JobTitle3Agent28/10/2012Phone 17:30-19:00
71JobTitle3Agent28/11/2012Phone 09:30-10:45
72JobTitle3Agent28/11/2012Break 10:45-11:00
73JobTitle3Agent28/11/2012Phone 11:00-13:00
74JobTitle3Agent28/11/2012Lunch 13:00-13:30
75JobTitle3Agent28/11/2012Phone 13:30-15:30
76JobTitle3Agent28/11/2012Break 15:30-15:45
77JobTitle3Agent28/11/2012Phone 15:45-17:15
78JobTitle3Agent28/11/2012Break 17:15-17:30
79JobTitle3Agent28/11/2012Phone 17:30-20:00
80JobTitle3Agent28/14/2012Phone 12:30-15:00
81JobTitle3Agent28/14/2012Break 15:00-15:15
82JobTitle3Agent28/14/2012Phone 15:15-17:00
83JobTitle3Agent28/14/2012Lunch 17:00-17:30
84JobTitle3Agent28/14/2012Phone 17:30-19:30
85JobTitle3Agent28/14/2012Break 19:30-19:45
86JobTitle3Agent28/14/2012Phone 19:45-20:45
87JobTitle3Agent28/14/2012Break 20:45-21:00
88JobTitle3Agent28/14/2012Phone 21:00-23:00
89JobTitle3Agent28/15/2012Phone 12:30-14:00
90JobTitle3Agent28/15/2012Break 14:00-14:15
91JobTitle3Agent28/15/2012Phone 14:15-16:00
92JobTitle3Agent28/15/2012Lunch 16:00-16:30
93JobTitle3Agent28/15/2012Phone 16:30-19:15
94JobTitle3Agent28/15/2012Break 19:15-19:30
95JobTitle3Agent28/15/2012Phone 19:30-20:45
96JobTitle3Agent28/15/2012Break 20:45-21:00
97JobTitle3Agent28/15/2012Phone 21:00-23:00

<tbody>
</tbody>


This is how I would like the data to appear:

Excel 2007
ABCD
1Job TitleNameDateActivity
2JobTitle1Agent18/5/2012Phone 09:30-10:37
FDR 10:37-10:57
Phone 10:57-12:00
Break 12:00-12:15
Phone 12:15-13:06
FDR 13:06-13:31
Phone 13:31-14:00
Lunch 14:00-14:30
FDR 14:30-16:15
Break 16:15-16:30
FDR 16:30-17:45
Break 17:45-18:00
FDR 18:00-20:00
3JobTitle1Agent18/6/2012Technical Difficulty 09:30-10:10
Phone 10:10-10:45
Break 10:45-11:00
Phone 11:00-14:15
Lunch 14:15-14:45
Phone 14:45-16:45
Break 16:45-17:00
Phone 17:00-18:45
Break 18:45-19:00
Phone 19:00-20:00
4JobTitle1Agent18/7/2012Phone 09:30-11:30
Break 11:30-11:45
Phone 11:45-13:00
Lunch 13:00-13:30
Phone 13:30-16:00
Break 16:00-16:15
Phone 16:15-18:15
Break 18:15-18:30
Phone 18:30-20:00
5JobTitle3Agent28/7/2012PTO 12:30-14:15
PTO 14:15-14:30
PTO 14:30-16:15
PTO 16:15-16:45
PTO 16:45-18:30
PTO 18:30-18:45
PTO 18:45-20:45
PTO 20:45-21:00
PTO 21:00-23:00
6JobTitle1Agent18/8/2012FDR 09:30-11:15
Break 11:15-11:30
FDR 11:30-13:30
Lunch 13:30-14:00
FDR 14:00-15:30
Break 15:30-15:45
FDR 15:45-18:00
Break 18:00-18:15
Phone 18:15-20:00
Phone 11:00-14:00
7JobTitle3Agent28/9/2012Phone 12:30-13:45
Break 13:45-14:00
Phone 14:00-17:15
Lunch 17:15-17:45
Phone 17:45-19:00
Break 19:00-19:15
Phone 19:15-20:45
Break 20:45-21:00
Phone 21:00-23:00
8JobTitle3Agent28/10/2012Phone 08:30-09:45
Break 09:45-10:00
Phone 10:00-12:30
Lunch 12:30-13:00
Phone 13:00-14:45
Break 14:45-15:00
Phone 15:00-17:15
Break 17:15-17:30
Phone 17:30-19:00
9JobTitle3Agent28/11/2012Phone 09:30-10:45
Break 10:45-11:00
Phone 11:00-13:00
Lunch 13:00-13:30
Phone 13:30-15:30
Break 15:30-15:45
Phone 15:45-17:15
Break 17:15-17:30
Phone 17:30-20:00
10JobTitle1Agent18/12/2012Phone 09:30-11:45
Break 11:45-12:00
Phone 12:00-14:00
Lunch 14:00-14:30
FDR 14:30-16:00
Break 16:00-16:15
FDR 16:15-17:30
Break 17:30-17:45
FDR 17:45-20:00
11JobTitle1Agent18/13/2012Phone 09:30-11:15
Break 11:15-11:30
Phone 11:30-12:30
FDR 12:30-14:00
Lunch 14:00-14:30
FDR 14:30-16:00
Break 16:00-16:15
FDR 16:15-18:15
Break 18:15-18:30
FDR 18:30-20:00
12JobTitle1Agent18/14/2012Phone 09:30-11:30
Break 11:30-11:45
Phone 11:45-13:00
Lunch 13:00-13:30
Phone 13:30-16:45
Break 16:45-17:00
Phone 17:00-18:30
Break 18:30-18:45
Phone 18:45-20:00
13JobTitle3Agent28/14/2012Phone 12:30-15:00
Break 15:00-15:15
Phone 15:15-17:00
Lunch 17:00-17:30
Phone 17:30-19:30
Break 19:30-19:45
Phone 19:45-20:45
Break 20:45-21:00
Phone 21:00-23:00
14JobTitle1Agent18/15/2012Phone 09:30-12:00
Break 12:00-12:15
Phone 12:15-13:30
Lunch 13:30-14:00
Phone 14:00-16:00
Break 16:00-16:15
Phone 16:15-18:00
Break 18:00-18:15
Phone 18:15-20:00
15JobTitle3Agent28/15/2012Phone 12:30-14:00
Break 14:00-14:15
Phone 14:15-16:00
Lunch 16:00-16:30
Phone 16:30-19:15
Break 19:15-19:30
Phone 19:30-20:45
Break 20:45-21:00
Phone 21:00-23:00
16JobTitle1Agent18/16/2012Phone 11:00-14:00
17JobTitle3Agent28/16/2012Phone 12:30-14:15
Break 14:15-14:30
Phone 14:30-17:15
Lunch 17:15-17:45
Phone 17:45-19:00
Break 19:00-19:15
Phone 19:15-20:45
Break 20:45-21:00
Phone 21:00-23:00
18JobTitle3Agent28/17/2012Phone 12:30-14:45
Break 14:45-15:00
Phone 15:00-17:00
Lunch 17:00-17:30
Phone 17:30-19:15
Break 19:15-19:30
Phone 19:30-20:45
Break 20:45-21:00
Phone 21:00-23:00
19JobTitle1Agent18/19/2012Phone 09:30-11:45
Break 11:45-12:00
Phone 12:00-14:00
Lunch 14:00-14:30
FDR 14:30-16:00
Break 16:00-16:15
FDR 16:15-17:45
Break 17:45-18:00
Phone 18:00-20:00
20JobTitle1Agent18/20/2012Phone 09:30-11:00
Break 11:00-11:15
Phone 11:15-12:30
FDR 12:30-14:00
Lunch 14:00-14:30
FDR 14:30-16:00
Break 16:00-16:15
FDR 16:15-18:15
Break 18:15-18:30
FDR 18:30-20:00
21JobTitle1Agent18/21/2012Phone 09:30-11:30
Break 11:30-11:45
Phone 11:45-14:15
Lunch 14:15-14:45
Phone 14:45-16:45
Break 16:45-17:00
Phone 17:00-18:30
Break 18:30-18:45
Phone 18:45-20:00
22JobTitle3Agent28/21/2012Phone 12:30-15:00
Break 15:00-15:15
Phone 15:15-16:45
Lunch 16:45-17:15
Phone 17:15-19:30
Break 19:30-19:45
Phone 19:45-20:45
Break 20:45-21:00
Phone 21:00-23:00
Break 18:45-19:00
23JobTitle1Agent18/22/2012Phone 09:30-11:30
Break 11:30-11:45
Phone 11:45-13:15
Lunch 13:15-13:45
Phone 13:45-15:45
Break 15:45-16:00
Phone 16:00-18:45
Break 18:45-19:00
Phone 19:00-20:00
24JobTitle3Agent28/22/2012Phone 12:30-14:00
Break 14:00-14:15
Phone 14:15-16:15
Lunch 16:15-16:45
Phone 16:45-19:15
Break 19:15-19:30
Phone 19:30-20:45
Break 20:45-21:00
Phone 21:00-23:00
25JobTitle1Agent18/23/2012Phone 12:00-13:30
Break 13:30-13:45
Phone 13:45-16:00
26JobTitle3Agent28/23/2012Phone 12:30-14:45
Break 14:45-15:00
Phone 15:00-17:15
Lunch 17:15-17:45
Phone 17:45-19:45
Break 19:45-20:00
Phone 20:00-21:15
Break 21:15-21:30
Phone 21:30-23:00
27JobTitle3Agent28/24/2012Phone 12:30-14:30
Break 14:30-14:45
Phone 14:45-16:45
Lunch 16:45-17:15
Phone 17:15-19:15
Break 19:15-19:30
Phone 19:30-20:45
Break 20:45-21:00
Phone 21:00-23:00
28JobTitle1Agent18/26/2012Phone 09:30-12:00
Break 12:00-12:15
Phone 12:15-14:00
Lunch 14:00-14:30
FDR 14:30-15:45
Break 15:45-16:00
FDR 16:00-17:30
Break 17:30-17:45
FDR 17:45-20:00
29JobTitle1Agent18/27/2012Phone 09:30-10:45
Break 10:45-11:00
Phone 11:00-14:15
Lunch 14:15-14:45
Phone 14:45-16:00
Break 16:00-16:15
Phone 16:15-17:45
Break 17:45-18:00
Phone 18:00-20:00
30JobTitle1Agent18/28/2012Phone 09:30-12:00
Break 12:00-12:15
Phone 12:15-14:15
Lunch 14:15-14:45
Phone 14:45-16:45
Break 16:45-17:00
Phone 17:00-18:00
Break 18:00-18:15
Phone 18:15-20:00
FDR 18:00-20:00
31JobTitle3Agent28/28/2012Phone 12:30-14:45
Break 14:45-15:00
Phone 15:00-17:15
Lunch 17:15-17:45
Phone 17:45-20:30
Break 20:30-20:45
Phone 20:45-22:00
PTO 22:00-23:00

<tbody>
</tbody>

There could be up to 42 dates per agents, as many as 90 agents, and a varying number of activities for each date.

I'm struggling with how to separate the different dates and the alt+enter break to keep the actives on their one line within the cells.

Thank you for reading, my apologies for the large post.
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Sort by date Sort by votes
I have a solution.

First, reverse the order of your entries. This can be done by creating a helper column. Number the entries from 1 to whatever and then sort them from largest to smallest.

Then, run this code.


Code: 
Sub test()
Dim LR As Long
Dim str As String
LR = Range("C" & Rows.Count).End(xlUp).Row()
For LR = LR To 2 Step -1
    If Cells(LR, 3) = Cells(LR - 1, 3) Then
        str = str & Cells(LR, 4) & vbCrLf
        Cells(LR, 3).Rows.EntireRow.Delete
    Else
        str = str & Cells(LR, 4) & vbCrLf
            
        Cells(LR, 4).Value = str
        str = vbNullString
    End If
Next LR
            
End Sub


After you've dont that, delete the helper column and then do another sort.

This time by Job Title Then by Date.

Let me know if you need any help with getting that done.
 
Upvote 0
Or this will do it without the sorting to do along with it. Just run the code.

Code: 
Sub test()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim LR As Long
Dim str As String, temp As String
Dim sp() As String
Dim x As Integer, y As Integer
LR = Range("C" & Rows.Count).End(xlUp).Row()
For LR = LR To 2 Step -1
    If Cells(LR, 3) = Cells(LR - 1, 3) Then
        str = str & Cells(LR, 4) & vbCrLf
        Cells(LR, 3).Rows.EntireRow.Delete
    Else
        str = str & Cells(LR, 4) & vbCrLf
        str = Left(str, Len(str) - 2)
        sp = Split(str, Chr(13))
        str = vbNullString
            For x = LBound(sp) To UBound(sp)
                For y = x To UBound(sp)
                    If x < y Then
                        temp = Trim(Replace(sp(x), Chr(10), vbNullString))
                        sp(x) = Trim(Replace(sp(y), Chr(10), vbNullString))
                        sp(y) = Trim(Replace(temp, Chr(10), vbNullString))
                    End If
                Next y
            Next x
            
            For x = LBound(sp) To UBound(sp)
                str = str & sp(x) & vbCrLf
            Next x
                  
        Cells(LR, 4).Value = Left(str, Len(str) - 2)
        str = vbNullString
    End If
Next LR
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
 
Last edited:
Upvote 0
Thank you very much! I'm testing this out now. I will respond once it is all working as well, though may be a couple hours!
 
Upvote 0
I used the second bit of code. It is perfect. Thank you Irobbo314!

The Activitis end up with a question mark in a square at the end, I'm guessing due to the break. It there any way to avoid that?


 
Upvote 0
I don't see any question marks after I run the code off of the sample data. What do you mean by breaks? Breaks as an activity, or breaks in the data?
 
Upvote 0
I'll have to defer that one to another member. It might be a setting or a weird font that you r using, but for some reason it is showing your carriage returns as question marks.
 
Upvote 0
Hello,

I'm wondering how I would edit this code to not add the breaks, so all the data is on one row?

lrobbo314 said:
Or this will do it without the sorting to do along with it. Just run the code.

Code: 
Sub test()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim LR As Long
Dim str As String, temp As String
Dim sp() As String
Dim x As Integer, y As Integer
LR = Range("C" & Rows.Count).End(xlUp).Row()
For LR = LR To 2 Step -1
    If Cells(LR, 3) = Cells(LR - 1, 3) Then
        str = str & Cells(LR, 4) & vbCrLf
        Cells(LR, 3).Rows.EntireRow.Delete
    Else
        str = str & Cells(LR, 4) & vbCrLf
        str = Left(str, Len(str) - 2)
        sp = Split(str, Chr(13))
        str = vbNullString
            For x = LBound(sp) To UBound(sp)
                For y = x To UBound(sp)
                    If x < y Then
                        temp = Trim(Replace(sp(x), Chr(10), vbNullString))
                        sp(x) = Trim(Replace(sp(y), Chr(10), vbNullString))
                        sp(y) = Trim(Replace(temp, Chr(10), vbNullString))
                    End If
                Next y
            Next x
            
            For x = LBound(sp) To UBound(sp)
                str = str & sp(x) & vbCrLf
            Next x
                  
        Cells(LR, 4).Value = Left(str, Len(str) - 2)
        str = vbNullString
    End If
Next LR
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Question
Excel Formula for Dynamic Timetable with Variable Time Increments based on certain hours of the day
Replies
1
Views
331
Muhammad_Usman
Muhammad_Usman
D
  • Solved
Help with rank and difference.
Replies
3
Views
60
Fluff
Fluff
D
  • Question
Problems Encountered When Generating VBA Excel Charts with 15-Minute Interval Data.
Replies
0
Views
159
dilshod_k
D
K
  • Question
Excel Pivot table Time Values is not populating same as Source Sheet
Replies
1
Views
311
awoohaw
awoohaw
R
  • Question
Unified DDMMYY with variable data
2
Replies
11
Views
283
Alex Blakenburg
A

Forum statistics

Threads
1,215,063
Messages
6,122,935
Members
449,094
Latest member
teemeren

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top