Option Explicit
Sub ConvertExpandingNormalizing()
' constants
Const ksWSOriginal = "Hoja1"
Const ksOriginal = "OriginalList"
Const ksWSConverted = "Hoja1"
Const ksConverted = "ConvertedList"
Const ksDash = "-"
Const ksComma = ","
Const ksDigits = "0123456789"
' declarations
Dim rngO As Range, rngC As Range
Dim sOriginal As String, sConverted As String
Dim sPrefix As String, lFrom As Long, lTo As Long
Dim I As Long, J As Long, K As Long, L As Long, M As Long
Dim A As String, B As String, C As String
' start
Set rngO = Worksheets(ksWSOriginal).Range(ksOriginal)
Set rngC = Worksheets(ksWSConverted).Range(ksConverted)
With rngC
Range(.Rows(1), .Rows(.Rows.Count)).ClearContents
End With
' process
With rngO
For I = 1 To .Rows.Count
' input
sOriginal = .Cells(I, 1).Value & Space(1)
sConverted = ""
sPrefix = ""
lFrom = 0
lTo = 0
J = 0
Do
' chunk
K = InStr(J + 1, sOriginal, Space(1))
A = Mid(sOriginal, J + 1, K - J - 1)
L = InStr(A, ksDash)
' 1 or 2 values?
If L = 0 Then B = A Else B = Left(A, L - 1)
' 1st value
For M = 1 To Len(B)
C = Mid(B, M, 1)
If InStr(ksDigits, C) > 0 Then Exit For
Next M
If M <= Len(B) Then
sPrefix = Left(B, M - 1)
lFrom = Val(Right(B, Len(B) - M + 1))
Else
MsgBox "Value off format at row " & I & " : " & _
.Cells(I, 1).Value, _
vbApplicationModal + vbOKOnly, "Warning"
End If
' 2nd value?
If L = 0 Then lTo = lFrom Else lTo = Val(Right(A, Len(A) - L))
' build
For L = lFrom To lTo
If sConverted <> "" Then sConverted = sConverted & ksComma
sConverted = sConverted & sPrefix & L
Next L
' cycle
J = K
Loop Until J = Len(sOriginal)
' output
rngC.Cells(I, 1).Value = Trim(sConverted)
Next I
End With
' end
Worksheets(ksWSConverted).Activate
rngC.Cells(1, 1).Select
Set rngC = Nothing
Set rngO = Nothing
Beep
End Sub
