Read EXCEL records, parse, compute average, and copy to new EXCEL file

I have a EXCEL file w/ 4 fields: 'EmpNum', 'EmpName', 'City Coverage', 'Total Downtime'

 'City Coverage' has 1 to many names of cities covered by an employee.  If more than 1 city, the cities are separated by a comma.  I need to copy each record to another EXCEL file.  

If an employee covers more than 1 city, then that record is copied N times; once for each city.  The output file has 2 additional columns; 'City Total' and 'Avg Downtime'; 'City Total' has the count of cities covered by the employee. 'Avg Downtime' is the computed downtime average for each city.  

The enclosed VBA breaks out each employee w/ each city and works great.  I am not sure how to compute the downtime average, then add it to a new column to the sub-routine.

 I am very familiar w/ VBA, but have not used VBA w/ EXCEL.  Please help. Thank you, very much. Enclosed, is an EXCEL file w/ 2 tabs:  "Original" shows the data.  "Final" shows what the data needs to look like when completed.

Option Explicit

 Sub ReArrangeData()

     Dim swb As Workbook
     Dim dwb As Workbook
     
     Dim sws As Worksheet
     Dim dws As Worksheet
     
     Dim lr As Long
     Dim i As Long
     Dim ii As Long
     Dim j As Long
     Dim cnt As Long
     
     Dim x, y()
     Dim str() As String
     
     Application.ScreenUpdating = False
     Application.CopyObjectsWithCells = False
     Set swb = ThisWorkbook
     Set sws = swb.Sheets("Original")
     
     sws.Copy
     Set dwb = ActiveWorkbook
     Set dws = dwb.Sheets(1)
     
     lr = dws.Cells(Rows.Count, 1).End(xlUp).Row
     dws.Range("D2:D" & lr).Formula = "=LEN(C2)-LEN(SUBSTITUTE(C2,"","",""""))+1"
     cnt = Application.Sum(dws.Range("D2:D" & lr))
     x = dws.Range("A1").CurrentRegion.Value
     ReDim y(1 To cnt, 1 To 4)
     
     For i = 2 To UBound(x, 1)
         If x(i, 4) = 1 Then
             j = j + 1
             y(j, 1) = x(i, 1)
             y(j, 2) = x(i, 2)
             y(j, 3) = x(i, 3)
             y(j, 4) = x(i, 4)
         
         Else
             str = Split(x(i, 3), ",")
             For ii = 0 To UBound(str)
                 j = j + 1
                 y(j, 1) = x(i, 1)
                 y(j, 2) = x(i, 2)
                 y(j, 3) = Trim(str(ii))
                 y(j, 4) = x(i, 4)
             Next ii
         
         End If
     
     Next i
     
     dws.Range("A1").CurrentRegion.Offset(1).Clear
     dws.Range("A2").Resize(UBound(y), 4).Value = y
     dws.Range("D1").Value = "City Total"
     dws.Range("A1").CurrentRegion.Borders.Color = vbBlack
     dws.UsedRange.Columns.AutoFit
     Application.CopyObjectsWithCells = True
     Application.ScreenUpdating = True

 End Sub
Test_Data2.xlsx