Data Conversion

[Matthew12]

I'm hoping somebody here can help me with my problem as im well and truly fed up with it!

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)

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.

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

 

[Joe4]

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.

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

 

[Rick Rothstein]

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.

[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]

 

[Matthew12]

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.

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

 

[Joe4]

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:

Dim sessionDate As Date

to this:

Dim sessionDate As Variant

and it should work.

 

[Rick Rothstein]

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...

[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]

 

[Matthew12]

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:

Dim sessionDate As Date

to this:

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

 

[Joe4]

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).

 

[Matthew12]

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.

[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.

 

[Matthew12]

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!