Reformat Data

[bjwheeler]

I have data that has goes out to the right with Year columns. One record with many year columns. What I need is many records with one year column. I am trying to figure out if there is some way to 'automate' this process. Or at least a way to simplify the process. I have 30 columns of MaxofYear for each unique record (215 unique).


Original table:
ID MaxOf2014 MaxOf2013 MaxOf2012 MaxOf2011 MaxOf2010
2O001 -999 5 10 2 1
2O003 0 0 0 0 0
2O007 -999 -999 -999 -999 8
2O008 0 0 0 -999 0
2O011 -999 -999 -999 -999 -999


New Format:
ID Annual_Max Survey_Year
2O001 -999 2014
2O001 5 2013
2O001 10 2012
2O001 2 2011
2O001 1 2010
2O001 0 2009
2O001 5 2008

 

[NeonRedSharpie]

Sub thatPeskyTransposeMacro()'Saved in personal.xlsb
    
    Dim dataSheet As Worksheet
    Dim results As Worksheet
    
    Dim colOne As String
    Dim nextRow As Long
    
    nextRow = 2 'Assuming headers for results
    
    Set dataSheet = Sheets("Sheet1") 'Change this to where your table is
    Set results = Sheets("Sheet2") 'This is a blank sheet for your results
    
    With results 'Place headers
        .Cells(1, 1).Value = "Unique ID"
        .Cells(1, 2).Value = "Value"
        .Cells(1, 3).Value = "Header"
    End With
    
    
    With dataSheet
        For x = 2 To .Cells(Rows.Count, "A").End(xlUp).row 'For all cells in column A
            For y = 2 To .Cells(1, Columns.Count).End(xlToLeft).Column 'For all headers in row 1
                results.Cells(nextRow, 1).Value = .Cells(x, 1).Value 'Unique ID
                results.Cells(nextRow, 2).Value = .Cells(x, y).Value 'Value
                'results.Cells(nextRow, 3).Value = .Cells(1, y).Value 'Header
                results.Cells(nextRow, 3).Value = Right(.Cells(1, y).Value, 4) 'Modified header
                
                If .Cells(x, y) <> "" Then 'If there's actually a value then advance
                    nextRow = nextRow + 1
                End If
                
            Next y
        Next x
    End With
End Sub

My template slightly modified for your dates.

 

[bjwheeler]

NeonRedSharpie - That is awesome - exactly what I needed with very little modification! Greatly appreciated.