Thread: Report Cleanup - unmerge, move, align

In the attached report, I require the Final Outcome (as per sheet provided in file) from the Original Report (as per sheet in file).

I have changed the location to Zone1, 2, 3, student ID, and Session information, however the placement of the data is in the same cells.
The word "Session:" in Column B indicates the data in C (same line) needs to be replicated in Column B aligned against the Student ID.

The original report has merged cells, however unmerging does not corrupt the data, the data just needs to be moved in alignment with the ID and Name. Looking at the original report, as an example, the ID and Student on line 14 relates to data in line 15, the ID and Student on line 17 relates to data in line 18, the ID and Student on line 20 relates to data in line 21.

Any unwanted data is to be removed (see final outcome for data required).
In the Final outcome sheet, I have done this manually keeping the data in the same order from top to bottom from the Original Report.
This is not a necessity, as once in this format - provided the individual data is aligned correctly, I can sort it any way I need.

p.s. I'm hoping Rylo will pick this one up for me.

Thanks in advance.
Chris

Hi

OK, here goes

Sub aaa()
  Dim lastrow As Long, session As String, StudID As String
  Dim Stud As String, Sname As String
  lastrow = Cells.SpecialCells(xlCellTypeLastCell).Row
  
  For i = 5 To lastrow
    If Cells(i, "B") = "Session:" Then
      session = Cells(i, "C")
    ElseIf Len(Cells(i, "C")) > 0 And Len(Cells(i, "G")) > 0 And Len(Cells(i, "H")) > 0 Then
      StudID = Cells(i, "C")
      Stud = Cells(i, "G")
      Sname = Cells(i, "H")
    ElseIf Len(Cells(i, "L")) > 0 Then
      Cells(i, "A") = "X"
      Cells(i, "B") = session
      Cells(i, "C") = StudID
      Cells(i, "G") = Stud
      Cells(i, "H") = Sname
    End If
  Next i
    
  Cells.MergeCells = False
  'Range("A1:A" & lastrow).EntireRow.RowHeight = 12.75
  Range("A1:A" & lastrow).UseStandardHeight = True
  Rows("1:5").EntireRow.Delete
  Range("A:AT").Sort key1:=Range("A1"), Header:=xlNo
  Range("A" & Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row & ":A" & lastrow).EntireRow.Delete shift:=xlUp
  For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
    If Len(Cells(1, i)) = 0 Then Cells(1, i).EntireColumn.Delete
  Next i
  Columns(1).Delete
  Rows("1:1").EntireRow.Insert shift:=xlDown
  Range("A1:L1").Value = Array("Session", "Stud ID", "Student", "Surname", "Campus", "Start", "End", "Fund", "ENR", "Attend Hrs", "Variation", "Results")
  Range("A1:L1").Font.Bold = True
  
  Columns("A:T").AutoFit
  ActiveWindow.FreezePanes = False
End Sub

rylo