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