Reformatting Table in Excel

[Michi96]

Hello I have a database as:

ID	Start date	End date	Division
100	15/01/96	17/03/09	1
100	18/03/09	22/05/11	1
100	25/05/11	2/05/18	2
100	3/05/18	7/06/20	2
100	7/06/20	20/12/20	1
101	...	...	...

I would like to reformat the table so that for each ID there is only row with the start date and end date that ID has been in each division:

ID	Start date	End date	Division
100	15/01/96	22/05/11	1
100	25/05/11	7/06/20	2
100	7/06/20	20/12/20	1
101	...	...	...

Do you have any idea on how to do this?

Thank you so much in advance.

 

[hnsd24_CN]

I'd like to help you, but I haven't found obvious rules in your two tables For example, in the first table, I inferred from row 2:5 that B6 should be put with C7. In fact, you put B6 and C6 together in the second table

 

[Michi96]

Thank you for your reply. Yes indeed, this is because people could switch division from 1 to 2 and I need to respect the order of time. For ID 100 this means that: I need a row in which he has been in division 1, a row in which he has been in division 2, and a row showing that he has been in division 1 again.

Hope this clarifies a little bit my dilemma.
Thanks!!

 

[ZVI]

Hi,
Try this code:

Sub ReformattingTable()
  
  Const SRC = "A1:D1"       ' The 1st row of the source range
  Const DEST = "F1"         ' The 1st destination cell
  Const ID = 1, EDATE = 3, DIV = 4
  
  Dim a(), b()
  Dim i As Long, j As Long, k As Long
  Dim key As String
  
  a() = Range(SRC, Cells(Rows.Count, Range(SRC).Column).End(xlUp))
  ReDim b(1 To UBound(a), 1 To UBound(a, 2))
  
  ' Populate b() by destination data
  With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(a)
      key = CStr(a(i, DIV))
      If Len(key) > 0 Then
        key = a(i, ID) & "_" & key
        If .Exists(key) Then
          b(.Item(key), EDATE) = a(i, EDATE)
          .Remove key
        Else
          .Item(key) = i
          j = j + 1
          For k = 1 To DIV
            b(j, k) = a(i, k)
          Next
        End If
      End If
    Next
  End With
  
  ' Clear destination range
  Range(DEST).Resize(Cells.SpecialCells(xlCellTypeLastCell).Row, DIV).ClearContents
  
  ' Put the destination data
  Range(DEST).Resize(j, DIV).Value = b()
  
End Sub