Normalize data, part 2
Here is another macro to normalize data.
Scenario: The user has entered multiple values in the same cell.
The macro reorganizes values into a cell each.
VBA macro
Sub NormalizeData()
Dim WS As Worksheet
Dim DelCh As String
Dim r As Single, c As Single
Dim rng As Range
On Error Resume Next
Set rng = Application.InputBox(Prompt:="Select cell range:", _
Title:="Normalize data", _
Default:=Selection.Address, Type:=8)
On Error GoTo 0
DelCh = InputBox("Delimiting character:")
Set WS = Sheets.Add
Application.ScreenUpdating = False
c = 1
For r = 1 To rng.Rows.CountLarge
Call Recursive(r, c, rng, DelCh, WS)
Next r
WS.Range("1:" & Rows.CountLarge).EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Sub Recursive(r As Single, c As Single, rng As Range, DelCh As String, WS As Object)
Dim str As Variant
Dim cc As Single, ccc As Single
str = Split(rng.Cells(r, c).Value, DelCh)
For i = 0 To UBound(str)
If c = 1 Then
For ccc = 1 To rng.Columns.CountLarge
If WS.Cells(Rows.Count, ccc).End(xlUp).Row + 1 > j Then
j = WS.Cells(Rows.Count, ccc).End(xlUp).Row + 1
End If
Next ccc
Else
j = WS.Cells(Rows.Count, c).End(xlUp).Row + 1
End If
WS.Range("A1").Offset(j - 1, c - 1).Value = str(i)
If c - 1 > 0 Then
If WS.Range("A1").Offset(j - 1, c - 2).Value = "" Then
WS.Range("A1").Offset(j - 1, c - 2).Value = _
WS.Range("A1").Offset(j - 2, c - 2).Value
End If
End If
If c = rng.Columns.CountLarge Then
If i <> 0 Then
For cc = 1 To rng.Columns.CountLarge - 1
WS.Range("A1").Offset(j - 1, cc - 1).Value = _
WS.Range("A1").Offset(j - 2, cc - 1).Value
Next cc
End If
Else
Call Recursive(r, c + 1, rng, DelCh, WS)
End If
Next i
End Sub
Download excel *.xlsm file
Normalize data2.xlsm
Related posts:
Identify missing values in a column using excel formula
Extract cell references from all cell ranges populated with values in a sheet

















