Myroslav Gusyak

Restructure Excel database

As a data scientist, I often need answer a wide variety of questions relating to data manipulation. Most f time I need reshape data from wide to long format or vice versa. In statistical packages, it’s not a problem but in excel it is not an easy task. Especially if it is a specific reshape task.

One of the last my work reshaped the table like this:

Name Email City Phone Black White
Trevor Schneider trevor@gmail.com New Totonto +1-403-334-1213 4 0
Richard Casey rcasey@gmail.com Lethbridge +1-780-237-2873 1 1
Louis Dawson dawson@hotmail.com Wasagaming +1-403-839-8225 0 2
We have customers who have purchased a specific product. This product can be either white or black. Also, customers can purchase multiple units of a product. The main task is to get the table where we have one line per one product (black or white). However, we must keep a cumulative amount of product that the buyer purchased.

In this case, we need to use Visual Basic for application (VBA). We must go through each line for a black product then for white and every time count their quantity.

Finally our database must looks like:

Name Email City Phone Color Item Number
Kenneth Fields  Kenneth1979@mail.com  Saguenay  +1-403-311-2319 Black 1
Ollie Terry olllie@gmail.com  Sudbury  +1-403-337-7343 Black 2
Lonnie Moore  Moore@hotmail.com  Terrebonne  +1-403-237-5699 Black 3
Craig Massey  Craig@yahoo.com  Laval  +1-403-224-1119 White 4
Marco Morales  MMorales@mail.com  Hawkesbury  +1-403-894-7719 Black  1
Cynthia Edwards  Cyntia@yahoo.com  Boucherville  +1-403-314-7578 Black 2
Alma Ortega Ortega@gmail.com  Sainte-Julie  +1-403-334-7319 White  1
Patrick Powell Powell_pre@mail.com Victoriaville  +1-403-354-7467 White  3

And VBA code for this transformation:

Private Sub Button_Click()
 For i = 2 To Sheets("ks").Range("A" & Rows.Count).End(xlUp).Row
   n = 1
     For j = 1 To Worksheets("ks").Cells(i, 47)
       With Worksheets("reshape")
         lr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
       End With
       Worksheets("ks").Range("A" & i & ":AS" & i).Copy Worksheets("reshape").Range("A" & lr)
       Worksheets("reshape").Cells(lr, 8) = Worksheets("ks").Cells(1, 47)
       Worksheets("reshape").Cells(lr, 4) = n
       n = n + 1
     Next j
     For k = 1 To Worksheets("ks").Cells(i, 48).Value
       With Worksheets("reshape")
         lr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
       End With
       Worksheets("ks").Range("A" & i & ":AS" & i).Copy Worksheets("reshape").Range("A" & lr)
       Worksheets("sheet2").Cells(lr, 8) = Worksheets("ks").Cells(1, 48)
       Worksheets("sheet2").Cells(lr, 4) = n
       n = n + 1
     Next k
 Next i
End Sub