How to pop out individual data from cluster of data

[GINN]

Cell A1 has 345-347,456;567,720
In column B, I would like to extract the above data as under:

B1 345
B2 346
B3 347
B4 456
B5 567
B6 720

 

[Ron Rosenfeld]

Cell A1 has 345-347,456;567,720
In column B, I would like to extract the above data as under:

B1 345
B2 346
B3 347
B4 456
B5 567
B6 720

This can be done with formulas, if all of your A1 entries are exactly as you
describe. However, it is more easily done with a UDF, which can also be
adapted in case your A1 content does not consist solely of separated integers.

The function below will return all the integer values as NUMERIC data, or a
blank.

It is used in the form of =ExtrNums(cell_ref, Index)

To enter this User Defined Function (UDF), <alt-F11> opens the Visual Basic
Editor.
Ensure your project is highlighted in the Project Explorer window.
Then, from the top menu, select Insert/Module and
paste the code below into the window that opens.

To use this User Defined Function (UDF):

B1: =ExtrNums($A$1,ROWS($1:1))

Then fill down until you begin returning blanks.

If it does not precisely meet your requirements, it can be easily modified.

=============================
Option Explicit
Function ExtrNums(s As String, Index As Long) As Variant
Dim re As Object, mc As Object
Const sPat As String = "\d+"

Set re = CreateObject("vbscript.regexp")
re.Pattern = sPat
re.Global = True

Set mc = re.Execute(s)
If Index > mc.Count Then
ExtrNums = ""
Else
ExtrNums = CDbl(mc(Index - 1))
End If
Set re = Nothing
End Function
====================================
--ron

 

[Mike H]

Hi,

If I understand correctly then when there is a - you want the numbers
missing in the range. If I'm correct then try this

Sub SplitOut()
rowno = 1
Dim numstring As Variant
numstring = Range("A1").Value
numstring = WorksheetFunction.Substitute(numstring, " ", "")
numstring = WorksheetFunction.Substitute(numstring, ";", ",")
s = Split(numstring, ",")
For x = 0 To UBound(s)
If InStr(s(x), "-") > 0 Then
t = Split(s(x), "-")
For y = Val(t(0)) To Val(t(UBound(t)))
Cells(rowno, 8).Value = y
rowno = rowno + 1
Next
Else
Cells(rowno, 8).Value = Val(s(x))
rowno = rowno + 1
End If
Next
End Sub

Mike

 

[Ron Rosenfeld]

This can be done with formulas, if all of your A1 entries are exactly as you
describe. However, it is more easily done with a UDF, which can also be
adapted in case your A1 content does not consist solely of separated integers.

The function below will return all the integer values as NUMERIC data, or a
blank.

It is used in the form of =ExtrNums(cell_ref, Index)

To enter this User Defined Function (UDF), <alt-F11> opens the Visual Basic
Editor.
Ensure your project is highlighted in the Project Explorer window.
Then, from the top menu, select Insert/Module and
paste the code below into the window that opens.

To use this User Defined Function (UDF):

B1: =ExtrNums($A$1,ROWS($1:1))

Then fill down until you begin returning blanks.

If it does not precisely meet your requirements, it can be easily modified.

=============================
Option Explicit
Function ExtrNums(s As String, Index As Long) As Variant
Dim re As Object, mc As Object
Const sPat As String = "\d+"

Set re = CreateObject("vbscript.regexp")
re.Pattern = sPat
re.Global = True

Set mc = re.Execute(s)
If Index > mc.Count Then
ExtrNums = ""
Else
ExtrNums = CDbl(mc(Index - 1))
End If
Set re = Nothing
End Function
====================================
--ron

I see from Mike's post I misinterpreted your request, and missed the fact that
you wanted all of the values returned if the integers were separated by a
hyphen.

Mike's solution should work fine.

If you would rather use a UDF that returns an array, instead of a Sub, you
could use the UDF below.

You could use it in a variety of ways

B1: =INDEX(ExtrNums($A$1),ROWS($1:1))
and fill down until you get errors

B1:
=IF(ISERR(INDEX(ExtrNums($A$1),ROWS($1:1))),"",INDEX(ExtrNums($A$1),ROWS($1:1)))

and fill down until you get blanks.

================================
Option Explicit
Function ExtrNums(s As String) As Variant
Dim aRes1, aRes2()
Dim aTemp As Variant
Dim sTemp As String
Dim i As Long, j As Long, k As Double, l As Double, m As Double

sTemp = Replace(s, ";", ",")
aRes1 = Split(sTemp, ",")
j = 0
ReDim aRes2(0 To UBound(aRes1))
For i = 0 To UBound(aRes1)
If IsNumeric(aRes1(i)) Then
aRes2(j) = CDbl(aRes1(i))
j = j + 1
Else
l = Val(aRes1(i)): m = Mid(aRes1(i), InStr(aRes1(i), "-") + 1)
ReDim Preserve aRes2(UBound(aRes2) + m - l)
For k = l To m
aRes2(j) = k
j = j + 1
Next k
End If
Next i
ExtrNums = aRes2
End Function
==================================

--ron

 

[GINN]

Hi ,

should I use this as user-defined function or If I straight away copy your
formula in the reference cell to get the desired answer. Pl. let me know how
to try your suggestion in excel work sheet functions.

 

[Gord Dibben]

You would use as a macro.

If you're not familiar with VBA and macros, see David McRitchie's site for
more on "getting started".

http://www.mvps.org/dmcritchie/excel/getstarted.htm

or Ron de De Bruin's site on where to store macros.

http://www.rondebruin.nl/code.htm

In the meantime..........

First...create a backup copy of your original workbook.

To create a General Module, hit ALT + F11 to open the Visual Basic Editor.

Hit CRTL + r to open Project Explorer.

Find your workbook/project and select it.

Right-click and Insert>Module. Paste the code in there. Save the
workbook and hit ALT + Q to return to your workbook.

Run or edit the macro by going to Tool>Macro>Macros.

You can also assign this macro to a button or a shortcut key combo.


Gord Dibben MS Excel MVP