Transforming data from one layout into another format

[Marcfar]

Linked is a sample of how my data set looks. Data content is of course different, but is about 1000 rows.

https://imgur.com/a/4EMP8r3

Desired Output:

https://imgur.com/a/XHdREBs

There are 2 outputs I have for different data sets I require to transform.

I need to transform original data to another table where: Province goes into column A. Column B has the code associated to the city. Column C indicates the Code data associated to "yes". And then this repeats for the next province.

The data set for the province needs to be all in 1 row. Within the code cell the data should be separated by a "/" in it's respective column. In another case no "/" needed, but a "alt enter" to next line within the cell.

I have couple data sets that I would apply this to, hence the different requirements mentioned above.

The reason it is in this format as it is a vendor provided document that works for our team and it's purpose. So same format was requested.

Tia.

 

[DanteAmor]

Hi and welcome to MrExcel

Put your data on the "Data" sheet, create 2 sheets and name them "Output1" and "Output2", the results will be on the sheets "Output1" and "Output2"

Run this macro:

Sub Transforming_data()
  Dim sh As Worksheet, sh1 As Worksheet, sh2 As Worksheet
  Dim a As Variant, b As Variant, c As Variant
  Dim i As Long, j As Long, k As Long
  
  Set sh = Sheets("Data")
  Set sh1 = Sheets("Output1")
  Set sh2 = Sheets("Output2")
  sh1.Cells.ClearContents
  sh2.Cells.ClearContents
  
  a = sh.Range("A1:E" & sh.Range("A" & Rows.Count).End(3).Row).Value2
  ReDim b(1 To UBound(a, 1), 1 To 3)
  ReDim c(1 To UBound(a, 1), 1 To 3)
  
  For i = 1 To UBound(a, 1)
    If LCase(Left(a(i, 1), 8)) = LCase("Province") Then
      j = j + 1
      b(j, 1) = a(i, 3)
      c(j, 1) = a(i, 3)
    End If
    If LCase(a(i, 1)) <> LCase("Province:") And LCase(a(i, 1)) <> LCase("City") Then
      If b(j, 2) = "" Then
        b(j, 2) = a(i, 4)
        c(j, 2) = a(i, 4)
      Else
        b(j, 2) = b(j, 2) & " /" & a(i, 4)
        c(j, 2) = c(j, 2) & Chr(10) & a(i, 4)
      End If
      If LCase(a(i, 5)) = LCase("yes") Then
        b(j, 3) = a(i, 4)
        c(j, 3) = a(i, 4)
      End If
    End If
  Next
  
  sh1.Range("A1:C1").Value = Array("Province", "Code", "Largest")
  sh2.Range("A1:C1").Value = Array("Province", "Code", "Largest")
  sh1.Range("A2").Resize(j, 3).Value = b
  sh2.Range("A2").Resize(j, 3).Value = c
End Sub