Combine multiple columns and rows for one record into one row.

[Bowtie63]

I'm using Excel 2003 and I have a question about combining columns and rows
into a row. The data is from a vendor program and it tracks employee
activities. The data export from the vendor that puts the data into 4
columns, with a minimum of 3 rows. The columns are: CustomerID, Name,
RecordType, and Record. It is the RecordType column that is repeated at
least 3 times. Below is an example:

CustID Name RecordType Record
1 Doe, John Activity Delivery
1 Doe, John Frequency 3 days/week
1 Doe, John Current Yes
1 Doe, John Activity Stock
1 Doe, John Frequency 3 days/week
1 Doe, John Current Yes
2 Smith, Jane Activity Front Desk
2 Smith, Jane Frequency Daily
2 Smith, Jane Current Yes
2 Smith, Jane Activity Loading Dock
2 Smith, Jane Frequency Weekends
2 Smith, Jane Current Yes
2 Smith, Jane Activity Call Center
2 Smith, Jane Frequency Holidays
2 Smith, Jane Current No

What I'm looking for is this:

CustID Name Activity Record Current
1 Doe, John Delivery 3 days/week Yes
1 Doe, John Stock 3 days/week Yes
2 Smith, Jane Front Desk Daily Yes
2 Smith, Jane Loading Dock Weekends Yes
2 Smith, Jane Call Center Holidays No

Until we get the vendor to fix their export function, how can I achieve the
above without using the transpose function? The export has over 25,000 rows.
Any help would be greatly appreciated. Thanks!

 

[JLatham]

Make a copy of the worksheet to test the code below on (it works with the
limited sample you provided) so that you don't lose data if it doesn't work
on your actual data. Code assumes that the entries on the sheet go unbroken
from start to finish. It also assumes that the column next to the Record
column is empty and available to use to move data into.

To put the code into your workbook, open the workbook and press [Alt]+[F11]
to open the VB Editor and use Insert | Module from the VBE menu to insert a
new code module. Then copy and paste the code below into that module. Make
any changes to the Const values that are needed. To run it, choose the sheet
with the original data on it and use Tools | Macro | Macros to identify the
macro and [Run] it.

Sub CombineRecords()
'change definitions of these Const
'values as required for your worksheet
'row number with first person's entry
Const firstDataRow = 2
'number of rows for a single record
Const rowsPerRecord = 3
'column with customer ID in it
Const custIDCol = "A"
'column with customer Name in it
Const nameCol = "B"
'column with activity description in it
Const typeCol = "C"
'column with detail for the activity
Const detailCol = "D"
'
Dim offsetToName As Integer
Dim offsetToType As Integer
Dim offsetToDetail As Integer
Dim activeRow As Long
Dim lastRow As Long
Dim deleteLoopCounter As Long
Dim baseCell As Range
'initialize offsets for faster operation
offsetToName = Range(nameCol & 1).Column - _
Range(custIDCol & 1).Column
offsetToType = Range(typeCol & 1).Column - _
Range(custIDCol & 1).Column
offsetToDetail = Range(detailCol & 1).Column - _
Range(custIDCol & 1).Column
'initialize data gathering values
Set baseCell = ActiveSheet.Range(custIDCol & firstDataRow)
activeRow = firstDataRow
'work down the sheet until we hit an empty
'cell in the Customer ID number column
'improve performance by turning off screen updating
Application.ScreenUpdating = False
Do While Not IsEmpty(baseCell)
'first row, just move Detail entry into type column
baseCell.Offset(0, offsetToType) = _
baseCell.Offset(0, offsetToDetail)
'second row, move frequency up and over into where
'first row's detail was at
baseCell.Offset(0, offsetToDetail) = _
baseCell.Offset(1, offsetToDetail)
'erase the detail entry so we can delete the row later
baseCell.Offset(1, offsetToDetail).ClearContents
'third row, move current indicator up & over to new column
baseCell.Offset(0, offsetToDetail + 1) = _
baseCell.Offset(2, offsetToDetail)
'erase the detail entry so we can delete the row later
baseCell.Offset(2, offsetToDetail).ClearContents
'
'set up for next record
activeRow = activeRow + rowsPerRecord
Set baseCell = ActiveSheet.Range(custIDCol & activeRow)
Loop ' end of IsEmpty() loop
Set baseCell = Nothing 'release back to system
'next we will remove rows that we cleared
'data from in the detail column
'assumes Customer ID entries stil exist
lastRow = _
ActiveSheet.Range(custIDCol & Rows.Count).End(xlUp).Row
For deleteLoopCounter = lastRow To firstDataRow Step -1
If IsEmpty(ActiveSheet.Range(custIDCol & _
deleteLoopCounter).Offset(0, offsetToDetail)) Then
'delete this no longer needed row
ActiveSheet.Range(custIDCol & _
deleteLoopCounter).EntireRow.Delete
End If
Next
Application.ScreenUpdating = True
End Sub

 

[Bowtie63]

Thank you! I'll give it a try and post back my results.

Make a copy of the worksheet to test the code below on (it works with the
limited sample you provided) so that you don't lose data if it doesn't work
on your actual data. Code assumes that the entries on the sheet go unbroken
from start to finish. It also assumes that the column next to the Record
column is empty and available to use to move data into.

To put the code into your workbook, open the workbook and press [Alt]+[F11]
to open the VB Editor and use Insert | Module from the VBE menu to insert a
new code module. Then copy and paste the code below into that module. Make
any changes to the Const values that are needed. To run it, choose the sheet
with the original data on it and use Tools | Macro | Macros to identify the
macro and [Run] it.

Sub CombineRecords()
'change definitions of these Const
'values as required for your worksheet
'row number with first person's entry
Const firstDataRow = 2
'number of rows for a single record
Const rowsPerRecord = 3
'column with customer ID in it
Const custIDCol = "A"
'column with customer Name in it
Const nameCol = "B"
'column with activity description in it
Const typeCol = "C"
'column with detail for the activity
Const detailCol = "D"
'
Dim offsetToName As Integer
Dim offsetToType As Integer
Dim offsetToDetail As Integer
Dim activeRow As Long
Dim lastRow As Long
Dim deleteLoopCounter As Long
Dim baseCell As Range
'initialize offsets for faster operation
offsetToName = Range(nameCol & 1).Column - _
Range(custIDCol & 1).Column
offsetToType = Range(typeCol & 1).Column - _
Range(custIDCol & 1).Column
offsetToDetail = Range(detailCol & 1).Column - _
Range(custIDCol & 1).Column
'initialize data gathering values
Set baseCell = ActiveSheet.Range(custIDCol & firstDataRow)
activeRow = firstDataRow
'work down the sheet until we hit an empty
'cell in the Customer ID number column
'improve performance by turning off screen updating
Application.ScreenUpdating = False
Do While Not IsEmpty(baseCell)
'first row, just move Detail entry into type column
baseCell.Offset(0, offsetToType) = _
baseCell.Offset(0, offsetToDetail)
'second row, move frequency up and over into where
'first row's detail was at
baseCell.Offset(0, offsetToDetail) = _
baseCell.Offset(1, offsetToDetail)
'erase the detail entry so we can delete the row later
baseCell.Offset(1, offsetToDetail).ClearContents
'third row, move current indicator up & over to new column
baseCell.Offset(0, offsetToDetail + 1) = _
baseCell.Offset(2, offsetToDetail)
'erase the detail entry so we can delete the row later
baseCell.Offset(2, offsetToDetail).ClearContents
'
'set up for next record
activeRow = activeRow + rowsPerRecord
Set baseCell = ActiveSheet.Range(custIDCol & activeRow)
Loop ' end of IsEmpty() loop
Set baseCell = Nothing 'release back to system
'next we will remove rows that we cleared
'data from in the detail column
'assumes Customer ID entries stil exist
lastRow = _
ActiveSheet.Range(custIDCol & Rows.Count).End(xlUp).Row
For deleteLoopCounter = lastRow To firstDataRow Step -1
If IsEmpty(ActiveSheet.Range(custIDCol & _
deleteLoopCounter).Offset(0, offsetToDetail)) Then
'delete this no longer needed row
ActiveSheet.Range(custIDCol & _
deleteLoopCounter).EntireRow.Delete
End If
Next
Application.ScreenUpdating = True
End Sub

I'm using Excel 2003 and I have a question about combining columns and rows
into a row. The data is from a vendor program and it tracks employee
activities. The data export from the vendor that puts the data into 4
columns, with a minimum of 3 rows. The columns are: CustomerID, Name,
RecordType, and Record. It is the RecordType column that is repeated at
least 3 times. Below is an example:

CustID Name RecordType Record
1 Doe, John Activity Delivery
1 Doe, John Frequency 3 days/week
1 Doe, John Current Yes
1 Doe, John Activity Stock
1 Doe, John Frequency 3 days/week
1 Doe, John Current Yes
2 Smith, Jane Activity Front Desk
2 Smith, Jane Frequency Daily
2 Smith, Jane Current Yes
2 Smith, Jane Activity Loading Dock
2 Smith, Jane Frequency Weekends
2 Smith, Jane Current Yes
2 Smith, Jane Activity Call Center
2 Smith, Jane Frequency Holidays
2 Smith, Jane Current No

What I'm looking for is this:

CustID Name Activity Record Current
1 Doe, John Delivery 3 days/week Yes
1 Doe, John Stock 3 days/week Yes
2 Smith, Jane Front Desk Daily Yes
2 Smith, Jane Loading Dock Weekends Yes
2 Smith, Jane Call Center Holidays No

Until we get the vendor to fix their export function, how can I achieve the
above without using the transpose function? The export has over 25,000 rows.
Any help would be greatly appreciated. Thanks!