Excel Change Column Values To Separate Rows

Question

I have a table that looks like this:

  +-------+------------+------------+------------+
1 | Company | Invoice # | Employee 1  | Employee 2 |
  +=======+============+============+============+
2 | A       | 12345     | 10 hours    | 2 hours    | 
3 | A       | 23456     | 8 hours     | 3 hours    | 
4 | A       | 34567     | 4 hours     | 4 hours    |

And I want to generate a table that is like this:

  +-------+-------------+-------------+-----------+
1 | Company | Invoice # | Employee    | Hours      |
  +=======+============+============+============+
2 | A       | 12345     | Employee 1  | 10         | 
3 | A       | 12345     | Employee 2  | 2          | 
4 | A       | 23456     | Employee 1  | 8          |
5 | A       | 23456     | Employee 2  | 3          |

Basically, I want to only have one Employee column and a separate row for each employee's hours worked. Is there a VBA solution or preferably, a formula, that I could use to help me do this? Thanks in advance.

Answer 1

This may be a bit advanced, but something like this should work for you. I put comments in the code that will hopefully help explain what it's doing and why and should let you learn from it:

Sub tgr()

    'Declare variables
    Dim wb As Workbook              'Workbook containing the sheets
    Dim wsData As Worksheet         'Worksheet containing the source data
    Dim wsDest As Worksheet         'Worksheet used as destination for results output
    Dim aData() As Variant          'Array variable that will hold the source data
    Dim aResults() As Variant       'Array variable that will hold the results
    Dim lEmployeeHoursCount As Long 'Count of populated employee hours in source data table
    Dim iyData As Long              'Row (vertical) placeholder for aData array         (iy = index of vertical)
    Dim ixData As Long              'Column (horizontal) placeholder for aData array    (ix = index of horizontal)
    Dim iyResult As Long            'Row (vertical) placeholder for aResults array      (iy = index of vertical)

    Set wb = ActiveWorkbook
    Set wsData = wb.Sheets("Sheet1")    'Change the sheet name to the actual sheet name

    'Get source data
    With wsData.Range("A1").CurrentRegion
        'Verify data exists
        If .Rows.Count = 1 Then Exit Sub    'No data
        aData = .Value
        'Verify employee hours are populated
        With .Offset(1, 2).Resize(.Rows.Count - 1, .Columns.Count - 2)
            lEmployeeHoursCount = .Cells.Count - WorksheetFunction.CountBlank(.Cells)
            If lEmployeeHoursCount = 0 Then Exit Sub    'No populated employee hours
            ReDim aResults(1 To lEmployeeHoursCount, 1 To 4)
        End With
    End With

    'Loop through the employee hours section of the source data table
    For iyData = 2 To UBound(aData, 1)
        For ixData = 3 To UBound(aData, 2)
            'Verify the employee hour cell is populated
            If Len(Trim(aData(iyData, ixData))) > 0 Then
                'Found to be populated, convert to the Result format and add it to Result array
                iyResult = iyResult + 1
                aResults(iyResult, 1) = aData(iyData, 1)    'Company
                aResults(iyResult, 2) = aData(iyData, 2)    'Invoice #
                aResults(iyResult, 3) = aData(1, ixData)    'Employee Name
                aResults(iyResult, 4) = Trim(Replace(aData(iyData, ixData), "hours", vbNullString, , , vbTextCompare))  'Hours, but only the number
            End If
        Next ixData
    Next iyData

    'Verify result data exists
    If iyResult > 0 Then
        'Check if Destination worksheet exists already
        On Error Resume Next
        Set wsDest = wb.Sheets("Results")
        On Error GoTo 0
        If wsDest Is Nothing Then
            'Create worksheet if it doesn't already exists
            Set wsDest = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
            wsDest.Name = "Results"
            With wsDest.Range("A1").Resize(, UBound(aResults, 2))
                .Value = Array("Company", "Invoice #", "Employee", "Hours")
                .Font.Bold = True
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
            End With
        Else
            'Worksheet exists, clear previous results
            wsDest.Range("A1").CurrentRegion.Offset(1).ClearContents
        End If
        'Populate results
        wsDest.Range("A2").Resize(UBound(aResults, 1), UBound(aResults, 2)).Value = aResults
        wsDest.Range("A1").CurrentRegion.EntireColumn.AutoFit
    End If

End Sub

How to use a macro:

1. Make a copy of the workbook the macro will be run on
   • Always run new code on a workbook copy, just in case the code doesn't run smoothly
   • This is especially true of any code that deletes anything
2. In the copied workbook, press ALT+F11 to open the Visual Basic Editor
3. Insert | Module
4. Copy the provided code and paste into the module
5. Close the Visual Basic Editor
6. In Excel, press ALT+F8 to bring up the list of available macros to run
7. Double-click the desired macro (I named this one tgr)