Generate Multiple Rows Of Data From One Row of Data That Spans Across Many Columns

Option Explicit
Option Base 1
'Found original VBA here...
'http://stackoverflow.com/questions/3698442/convert-row-with-columns-of-data-into-column-with-multiple-rows-in-excel


Type employee
    info() As Variant
    Deduction(9) As Variant
    Benefit(9) As Variant
End Type


Sub reOrgV2_New(inSource As Range, inTarget As Range)
'' This version works directly on the worksheet
'' and transfers the result directly to the target
'' given as the top-left cell of the result.
 
    Dim resNames() As Variant
    Dim propNum As Long
    Dim srcRows As Long
    Dim resRows As Long
    Dim i As Long
    Dim j As Long
    Dim g As Long
    Dim emps() As employee
 
    resNames = Array("ID Number", "Last Name", "First Name", "Deduction Desc", "Deduction Amount", "Deduction Start Date", "Deduction Stop Date", _
    "Benefit Desc", "Benefit Amount", "Benefit Start Date", "Benefit Stop Date")
    
    srcRows = inSource.Rows.Count
    ReDim emps(srcRows)
    
    For i = 1 To srcRows
        With emps(i)
            g = 4
            .info = Range(inSource.Item(i, 1), inSource.Item(i, 3))
            For j = 1 To 9
                .Deduction(j) = Range(inSource.Item(i, g), inSource.Item(i, g + 3)).Value
                .Benefit(j) = Range(inSource.Item(i, g + 36), inSource.Item(i, g + 39)).Value
                g = g + 4
            Next j
        End With
    Next i
    
    inTarget.CurrentRegion.ClearContents
    inTarget.Offset(-1, 0).Resize(1, 11).Value = resNames
    g = -1
    For i = 1 To srcRows
        For j = 1 To 9
            With emps(i)
                If .Deduction(j)(1, 1) <> "" Or .Benefit(j)(1, 1) <> "" Then
                    g = g + 1
                    inTarget.Offset(g, 0).Resize(1, 3).Value = .info
                    inTarget.Offset(g, 3).Resize(1, 4).Value = .Deduction(j)
                    inTarget.Offset(g, 7).Resize(1, 4).Value = .Benefit(j)
                Else
                    Exit For
                End If
            End With
        Next j
    Next i
    
End Sub


'' Call ReOrgV2_New with input and output ranges
Sub ReOrg_New()
    Dim ws As Worksheet
    Dim i As Long, rInData As Range
    
    Set rInData = Range("InData!A2").CurrentRegion
    Set rInData = rInData.Offset(1, 0).Resize(rInData.Rows.Count - 1, rInData.Columns.Count)




    reOrgV2_New rInData, [OutData!A2]
    
    With Sheets("OutData")
        .Select
        .Range("A1").CurrentRegion.EntireColumn.AutoFit
        .Columns("A:D").HorizontalAlignment = xlLeft
        .Columns("E:G").HorizontalAlignment = xlRight
        .Columns("H:H").HorizontalAlignment = xlLeft
        .Columns("I:K").HorizontalAlignment = xlRight
        .Rows(1).HorizontalAlignment = xlCenter
    End With




End Sub