Excel-Change Table Data to Normalize Data

Question

I want to create some web application using basic data from Excel but the structur of data need to be adjust

Can anyone help me to change this table
A B C D
E F G H
I J K L
M N O P

to

A B
A C
A D
E F
E G
E H
I J
I K
I L
M N
M O
M P

or something like that, I already try using this macro

http://www.get-digital-help.com/2012/05/07/vba-macro-normalize-data/

it works on hundreds data but when I try to using it on >12000 data it stop working

Possible duplicate of [Convert matrix to 3-column table ('reverse pivot', 'unpivot', 'flatten', 'normalize')](https://stackoverflow.com/questions/20541905/convert-matrix-to-3-column-table-reverse-pivot-unpivot-flatten-normal) — BigBen, Apr 26 '19 at 01:16

score 0 · Answer 1 · answered Apr 26 '19 at 05:04

Try this:

'select a cell in your data before running
Sub DoIt()

    Dim data, n As Long, r As Long, c As Long
    Dim result(), i As Long

    With Selection.CurrentRegion
        data = .Value
        n = .Cells.Count
    End With

    ReDim result(1 To n, 1 To 2)
    i = 0

    For r = 1 To UBound(data, 1)
        For c = 2 To UBound(data, 2)
            If Len(data(r, c)) > 0 Then
                i = i + 1
                result(i, 1) = data(r, 1)
                result(i, 2) = data(r, c)
            End If
        Next c
    Next r

    'adjust output location to suit
    ActiveSheet.Range("G1").Resize(i, 2) = result

End Sub

Input/output:

Pavel_V · Accepted Answer · 2019-04-26T07:07:20.520

The issue with the macro you pointed to is in lines

Rng.Offset(r, 0).Value

At least to me when I remove the reference to the range and replace it with reference to first cell for example like this

WS1.Range("A1").Offset(r, 0).Value

it speeds up the macro tremendously = I ran it on 13000 lines and it was finished in 10 seconds using the macro from your link with only this adjustment.

Full macro with the change:

Sub NormalizeData()
Dim Rng As Range
Dim WS As Worksheet

Application.Calculation = xlCalculationManual
On Error Resume Next
Set Rng = Application.InputBox(Prompt:="Select a range to normalize data" _
, Title:="Select a range", Default:=ActiveCell.Address, Type:=8)
On Error GoTo 0

If Rng Is Nothing Then
Else
    Application.ScreenUpdating = False
    Set WS1 = ActiveSheet                       '<==== added this line
    Set WS = Sheets.Add
    i = 0
    For r = 0 To Rng.Rows.Count - 1             '<==== offset start changed to 0
        For c = 1 To Rng.Columns.Count - 1
            WS.Range("A1").Offset(i, 0) = WS1.Range("A1").Offset(r, 0).Value '<==== change
            WS.Range("A1").Offset(i, 1) = WS1.Range("A1").Offset(r, c).Value '<==== change
            i = i + 1
        Next c
        Application.StatusBar = r
    Next r
    WS.Range("A:C").EntireColumn.AutoFit
    Application.StatusBar = False
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End If
End Sub

can you give me an example for full macro change? i try to edit this line WS.Range("A1").Offset(i, 1) = Rng.Offset(r, 0).Value but its doesn't work — Aresta kuroryu, Apr 26 '19 at 06:53
not "WS", because WS is your result sheet. You need to point it to your data sheet. I added the full macro into the answer. You can delete the lines "Application.StatusBar" - I only added them to see how fast the calculation is — Pavel_V, Apr 26 '19 at 07:08

Excel-Change Table Data to Normalize Data

2 Answers2