OK, so I’m not a programmer in any way, but I’ve started to dabble a little bit in VBA. Working with migration origin/destination data, one job which is a perennial pain in the backside is converting matrix data into a paired list format. Therefore this morning I have written a little bit of VBA which you can run in any Excel spreadsheet to convert matrices to paired lists. Hope you find it useful – just copy and paste the text below into a new VBA module in your spreadsheet … 🙂

————————————————————————————————–

Sub MatrixToPairs()
    
'create a variable called dataFile and set it to equal the Excel file you have open
    Set dataFile = ActiveWorkbook
    
'count the number of columns with data in
    COLUMN = 1
    Do Until dataFile.Worksheets(1).Cells(1, COLUMN) = "" 'do until you reach an empty cell
        COLUMN = COLUMN + 1
    Loop
    
    COLUMN = COLUMN - 1
    
'count the number of rows with data in
    ROW = 1
    Do Until dataFile.Worksheets(1).Cells(ROW, 1) = "" 'do until you reach an empty cell
        ROW = ROW + 1
    Loop
    
    ROW = ROW - 1

'MsgBox "There are " & row & "rows and " & column & "columns in this data set"
    
'create two variables - origin and destination
    ORIGIN = ROW
    DESTIN = COLUMN
    
'now redimension the arrays you are going to put the data into based on the
'number of rows and columns

    ReDim OLABEL(ORIGIN), DLABEL(DESTIN), DATA(ORIGIN, DESTIN)

'read in your row/origin and column/destination labels

    For i = 1 To ORIGIN - 1
        OLABEL(i) = dataFile.Worksheets(1).Cells(i + 1, 1)
    Next i
    
    For j = 1 To DESTIN - 1
        DLABEL(j) = dataFile.Worksheets(1).Cells(1, j + 1)
    Next j

'now fill your data array with values from the file
    
    For i = 1 To ORIGIN - 1
        For j = 1 To DESTIN - 1
            DATA(i, j) = dataFile.Worksheets(1).Cells(i + 1, j + 1)
        Next j
    Next i
    
'now write out the data in a paired list format

'first add a new sheet to your excel file and make it the active sheet

    dataFile.Sheets.Add
    ActiveSheet.Move After:=Sheets(Worksheets.Count)

'put in some column headers

    k = 1

        dataFile.Worksheets(Worksheets.Count).Cells(k, 1) = "Origin"
        dataFile.Worksheets(Worksheets.Count).Cells(k, 2) = "Destination"
        dataFile.Worksheets(Worksheets.Count).Cells(k, 3) = "Data"

'now write out the data as a paired list
   
    For i = 1 To ORIGIN - 1
        For j = 1 To DESTIN - 1
            k = k + 1
            dataFile.Worksheets(Worksheets.Count).Cells(k, 1) = OLABEL(i)
            dataFile.Worksheets(Worksheets.Count).Cells(k, 2) = DLABEL(j)
            dataFile.Worksheets(Worksheets.Count).Cells(k, 3) = DATA(i, j)
        Next j
    Next i

End Sub