Data Conversion

Matthew12

New Member
Joined
May 16, 2017
Messages
8
I'm hoping somebody here can help me with my problem as im well and truly fed up with it! :mad::LOL:

I have thousands of rows like in the example image below. This record summarises the attendance for a course of treatment.
At system level this record is linked to the patient attending and the worker and venue facilitating. These fields are important as we need
to be able generate case studies for clients, monitor worker performance and produce reports for our partners - all of which include attendance info.
(it actually goes up to 10 sessions in case it makes a difference)


OO2zt.png




I need to convert the data above so that i can aggreagate each booked session to a single date field and still be able to filter at row level by clients,
workers and venues. The below table would be ideal, with each session having its own record with the relevant client, worker and venue data.

Allmb.png



Is there anyway this can be achieved? Big thanks for any help you can provide! If you require further information please just ask.
 
Last edited by a moderator:

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Welcome to the Board!

Give this code a try. You may need to change the sheet name from "Data" to whatever the name of your sheet with your data is.
It will create a new sheet named "Final" and place the newly formatted data there.
Code:
Sub MyCopy()

    Dim srcWS As Worksheet
    Dim destWS As Worksheet
    Dim lastRow As Long
    Dim myRow As Long
    Dim myCol As Long
    Dim rowCount As Long
    
    Dim clientID As String
    Dim workerID As String
    Dim venueID As String
    Dim sessionID As String
    Dim sessionDate As Date
    
    Application.ScreenUpdating = False
    
'   Set source sheet
    Set srcWS = Sheets("Data")
    
'   Add destination worksheet
    Sheets.Add
    ActiveSheet.Name = "Final"
    Set destWS = Sheets("Final")
    
'   Enter titles on final sheet
    destWS.Activate
    Range("A1") = "Client ID"
    Range("B1") = "Worker ID"
    Range("C1") = "Venue ID"
    Range("D1") = "Session"
    Range("E1") = "Session Date"
    
'   Find number of rows with data on source sheet
    srcWS.Activate
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through all rows on source sheet, starting with row 2
    rowCount = 2
    For myRow = 2 To lastRow
'       Get values from source sheet
        clientID = srcWS.Cells(myRow, "A")
        workerID = srcWS.Cells(myRow, "B")
        venueID = srcWS.Cells(myRow, "C")
        myCol = 4
        Do Until srcWS.Cells(myRow, myCol) = ""
            sessionID = srcWS.Cells(myRow, myCol)
            sessionDate = srcWS.Cells(myRow, myCol + 1)
'           Paste to destination
            destWS.Cells(rowCount, "A") = clientID
            destWS.Cells(rowCount, "B") = workerID
            destWS.Cells(rowCount, "C") = venueID
            destWS.Cells(rowCount, "D") = sessionID
            destWS.Cells(rowCount, "E") = sessionDate
'           Increment counters
            rowCount = rowCount + 1
            myCol = myCol + 2
        Loop
    Next myRow

    Application.ScreenUpdating = True

End Sub
 
Upvote 0
I wasn't sure where you wanted the output to go to, so the following macro will create as many new worksheets as there are sessions and name each sheet for the session, it will then copy the desired data to those sheets... your original data will remain untouched. Note that for this code to work, no sheets can exist with the names of the existing sessions.
Code:
[table="width: 500"]
[tr]
	[td]Sub RearrangeData()
  Dim R As Long, C As Long, LastRow As Long, SessionCount As Long, DataSource As Worksheet
  Set DataSource = ActiveSheet
  SessionCount = (Cells(1, Columns.Count).End(xlToLeft).Column - 3) / 2
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Application.ScreenUpdating = False
  For C = 1 To SessionCount
    Worksheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = DataSource.Cells(1, 2 + 2 * C).Value
    Range("A1:E1") = Array("Client ID", "Worker ID", "Venue ID", "Session Outcome", "Session Date")
    DataSource.Range("A2").Resize(LastRow - 1, 3).Copy Cells(Rows.Count, "A").End(xlUp).Offset(1)
    DataSource.Cells(2, 2 + 2 * C).Resize(LastRow - 1, 2).Copy Cells(Rows.Count, "D").End(xlUp).Offset(1)
  Next
  Application.ScreenUpdating = True
End Sub[/td]
[/tr]
[/table]
 
Last edited:
Upvote 0
Welcome to the Board!

Give this code a try. You may need to change the sheet name from "Data" to whatever the name of your sheet with your data is.
It will create a new sheet named "Final" and place the newly formatted data there.
Code:
Sub MyCopy()

    Dim srcWS As Worksheet
    Dim destWS As Worksheet
    Dim lastRow As Long
    Dim myRow As Long
    Dim myCol As Long
    Dim rowCount As Long
    
    Dim clientID As String
    Dim workerID As String
    Dim venueID As String
    Dim sessionID As String
    Dim sessionDate As Date
    
    Application.ScreenUpdating = False
    
'   Set source sheet
    Set srcWS = Sheets("Data")
    
'   Add destination worksheet
    Sheets.Add
    ActiveSheet.Name = "Final"
    Set destWS = Sheets("Final")
    
'   Enter titles on final sheet
    destWS.Activate
    Range("A1") = "Client ID"
    Range("B1") = "Worker ID"
    Range("C1") = "Venue ID"
    Range("D1") = "Session"
    Range("E1") = "Session Date"
    
'   Find number of rows with data on source sheet
    srcWS.Activate
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through all rows on source sheet, starting with row 2
    rowCount = 2
    For myRow = 2 To lastRow
'       Get values from source sheet
        clientID = srcWS.Cells(myRow, "A")
        workerID = srcWS.Cells(myRow, "B")
        venueID = srcWS.Cells(myRow, "C")
        myCol = 4
        Do Until srcWS.Cells(myRow, myCol) = ""
            sessionID = srcWS.Cells(myRow, myCol)
            sessionDate = srcWS.Cells(myRow, myCol + 1)
'           Paste to destination
            destWS.Cells(rowCount, "A") = clientID
            destWS.Cells(rowCount, "B") = workerID
            destWS.Cells(rowCount, "C") = venueID
            destWS.Cells(rowCount, "D") = sessionID
            destWS.Cells(rowCount, "E") = sessionDate
'           Increment counters
            rowCount = rowCount + 1
            myCol = myCol + 2
        Loop
    Next myRow

    Application.ScreenUpdating = True

End Sub

Hi Joe,

Thanks very much for taking the time to help me out! This almost works, or atleast its doing something thats getting close to what i need! I get a 'runtime error 13' type mismatch - this seems to be being cause by a blank cell.

The session date fields will only have a date inputted if the session was booked, otherwise it will be blank. The service being monitored is a 5 session service so many of the fields will be blank. Can this be solved?

Thanks
 
Upvote 0
An empty cell seems to work fine for me. So I am guessing that you have something like a blank space in there.

We can just change how we declare the variable at the top of the code.
So change this:
Code:
Dim sessionDate As Date
to this:
Code:
Dim sessionDate As Variant
and it should work.
 
Upvote 0
I am not sure if you saw what I posted in Message #3, but I need to add a line of code to remove IDs that did not attend the session. Here is that revised code...
Code:
[table="width: 500"]
[tr]
	[td]Sub RearrangeData()
  Dim R As Long, C As Long, LastRow As Long, SessionCount As Long
  Dim DataSource As Worksheet
  Set DataSource = ActiveSheet
  SessionCount = (Cells(1, Columns.Count).End(xlToLeft).Column - 3) / 2
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Application.ScreenUpdating = False
  On Error Resume Next
  For C = 1 To SessionCount
    Worksheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = DataSource.Cells(1, 2 + 2 * C).Value
    Range("A1:E1") = Array("Client ID", "Worker ID", "Venue ID", "Session Outcome", "Session Date")
    DataSource.Range("A2").Resize(LastRow - 1, 3).Copy Cells(Rows.Count, "A").End(xlUp).Offset(1)
    DataSource.Cells(2, 2 + 2 * C).Resize(LastRow - 1, 2).Copy Cells(Rows.Count, "D").End(xlUp).Offset(1)
    Columns("D").SpecialCells(xlBlanks).EntireRow.Delete
    Columns("A:E").AutoFit
  Next
  On Error GoTo 0
  Application.ScreenUpdating = True
End Sub[/td]
[/tr]
[/table]
 
Upvote 0
An empty cell seems to work fine for me. So I am guessing that you have something like a blank space in there.

We can just change how we declare the variable at the top of the code.
So change this:
Code:
Dim sessionDate As Date
to this:
Code:
Dim sessionDate As Variant
and it should work.

That did it! One other issue, for some reason the col headings aren't being created on the 'final' sheet. So all the data is converted starting from line 2 and line 1 is blank.


photo website hosting
 
Upvote 0
Unfortunately, I cannot see your image. My workplace blocks those sites.

I assume that your data starts on line 2, and line 1 is your headings. Do you have any blank lines in your data, or does your data not begin on row 2?

On the "Final" sheet, the code should be populating the headings in via code, and then paste the data, starting on line 2.

Also, be sure to paste this code in a Standard Module (and not directly in a sheet module).
 
Upvote 0
I wasn't sure where you wanted the output to go to, so the following macro will create as many new worksheets as there are sessions and name each sheet for the session, it will then copy the desired data to those sheets... your original data will remain untouched. Note that for this code to work, no sheets can exist with the names of the existing sessions.
Code:
[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub RearrangeData()
  Dim R As Long, C As Long, LastRow As Long, SessionCount As Long, DataSource As Worksheet
  Set DataSource = ActiveSheet
  SessionCount = (Cells(1, Columns.Count).End(xlToLeft).Column - 3) / 2
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Application.ScreenUpdating = False
  For C = 1 To SessionCount
    Worksheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = DataSource.Cells(1, 2 + 2 * C).Value
    Range("A1:E1") = Array("Client ID", "Worker ID", "Venue ID", "Session Outcome", "Session Date")
    DataSource.Range("A2").Resize(LastRow - 1, 3).Copy Cells(Rows.Count, "A").End(xlUp).Offset(1)
    DataSource.Cells(2, 2 + 2 * C).Resize(LastRow - 1, 2).Copy Cells(Rows.Count, "D").End(xlUp).Offset(1)
  Next
  Application.ScreenUpdating = True
End Sub[/TD]
[/TR]
</tbody>[/TABLE]

Thanks for this Rick its really appreciated. The issue with this is that once converted there will be well over 10,000 sessions so a sheet for each session would probably destroy my laptop! I need it contained within a single sheet as this data will eventually go into to Tableau and the sessions counted over a monthly period.
 
Upvote 0
Unfortunately, I cannot see your image. My workplace blocks those sites.

I assume that your data starts on line 2, and line 1 is your headings. Do you have any blank lines in your data, or does your data not begin on row 2?

On the "Final" sheet, the code should be populating the headings in via code, and then paste the data, starting on line 2.

Also, be sure to paste this code in a Standard Module (and not directly in a sheet module).

Yes i was placing the data in a sheet module and now that i've moved it the headers are being created! Thank you so much for your help! :)
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,237
Members
448,555
Latest member
RobertJones1986

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