Macro for expanding a range

[Macca1984]

Hi,

I have ranges of numbers which are inconsistent and random; by this i mean
there is no logical order.

I have separated the numbers using a dash i.e (45678 - 45688)

I want excel to expand the range so that it displays 45678, 45679, 45680,
etc up to 45688. The ranges are all in one cell however there is hundreds of
cells all with different ranges.

Some of the ranges are split up by single numbers to give an example ( 45678
- 45688; 45690; 45693 - 45699) it is important i only get the ranges
separated by dashes not the entire range.

I would like excel to convert the range and expand it into the same cell as
the single numbers with a preference for numerical ordering

Any help or assistance is greatly appreciated; i don't want to write this
out by hand if possible.

Ian

 

[Joel]

Try this code. the code take data from column A. Change as necessary. the
code will also stop if there are any empty cells in column A

Sub test3()

RowCount = 1
Do While Range("A" & RowCount) <> ""
If InStr(Range("A" & RowCount), "-") > 0 Then
CellStr = Range("A" & RowCount)
NewStr = ""
Do While CellStr <> ""
If InStr(CellStr, ";") > 0 Then
FirstPart = Trim(Left(CellStr, InStr(CellStr, ";") - 1))
CellStr = Trim(Mid(CellStr, InStr(CellStr, ";") + 1))
Else
FirstPart = CellStr
CellStr = ""
End If
If NewStr <> "" Then
NewStr = NewStr & "; "
End If
If InStr(FirstPart, "-") > 0 Then
FirstNum = Val(Trim(Left(FirstPart, InStr(FirstPart, "-") - 1)))
LastNum = Val(Trim(Mid(FirstPart, InStr(FirstPart, "-") + 1)))
For NumCount = FirstNum To LastNum
If NumCount <> FirstNum Then
NewStr = NewStr & ", " & NumCount
Else
NewStr = NewStr & NumCount
End If
Next NumCount
Else
NewStr = NewStr & FirstPart
End If
Loop
Range("A" & RowCount) = NewStr
End If
RowCount = RowCount + 1
Loop

End Sub

 

[Macca1984]

Thanks for the code; i run it and recieved a

run-time error '7':

Out of memory, closed all non essential programs any further suggestions?
Will it affect the code if there is no range only a single number i.e 75000?

 

[Joel]

The code only changes cells where it finds a dash (see line below). I don't
know if you made any changes to the code. The code was written to move down
column A on the active worksheet. If you changed the code to a differrent
column make sure you change ALL these places where the code looks at column A.

Run time error sounds like the code is in some loop. or it is finding a very
long string of data. In excel 2003 ther is a limit of 16K of data in a
single cell. If your range of numbers is very long maybe it is exceeding the
number of characters in a cell.

Instruction which checks for a dash in the cell.
If InStr(Range("A" & RowCount), "-") > 0

 

[Macca1984]

I did change the code to move to column k. I had no luck doing this though so
i decided to copy and paste the data into a new database and tried the
original code hoping for more luck.

i don't know if this will help but here is an example of the data and the
way i am laying it out; each cell is defined within brackets unless there is
only one value:

(55556 - 55563; 55565 - 55567; 55591; 55715; 55716; 55721; 55728; 55729;
55734; 55736 - 55746)
(55582 - 55590; 55701 - 55708)
(55658; 55652; 55653; 55661; 55662)
(55644; 55659; 55660)
(55651; 55645 - 55649; 5557; 55663 - 55666)
55650
(55642; 555643; 55655)
(55801 - 55813)
(55814 - 55823)
(55200 - 55201)
52144
(52134 - 52143; 52145 - 52150)
52133
(52120; 52123; 52127 - 52131)
52121
52132
(52101; 52102; 52124 - 52126)
(52103 - 52119; 52122)
(52201; 52203; 52205; 52207; 52211; 52215; 52218; 52222 - 52225)
(52208; 52245; 52250; 52252; 52256; 52258 - 52260; 52262; 52264; 52283 -
52285)
(52230; 52236; 52240- 52242; 52251; 52253; 52254)
(52267; 52278 - 52282)
(64651; 64652; 64656; 64658 - 64660; 64662; 64663 64665; 64668; 64670 -
64676; 64678; 64679; 64682; 64684 - 6489; 64691)

Does this seems to exceed the 16k data limit?

 

[Joel]

the problem was very simple. The Parenthesis was causing the problem. I was
using the VAL functtion in VBA to convert a string to a number. Instead of
having VaL("55326") and returning the number 55326, the code had
Val("(55326") and was returning 0. I had to remove the parenthesis and then
put them back.

Sub test3()

RowCount = 1
Do While Range("A" & RowCount) <> ""
If InStr(Range("A" & RowCount), "-") > 0 Then
CellStr = Range("A" & RowCount)
CellStr = Replace(CellStr, "(", "")
CellStr = Replace(CellStr, ")", "")
NewStr = ""
Do While CellStr <> ""
If InStr(CellStr, ";") > 0 Then
FirstPart = Trim(Left(CellStr, InStr(CellStr, ";") - 1))
CellStr = Trim(Mid(CellStr, InStr(CellStr, ";") + 1))
Else
FirstPart = CellStr
CellStr = ""
End If
If NewStr <> "" Then
NewStr = NewStr & "; "
End If
If InStr(FirstPart, "-") > 0 Then
FirstNum = Val(Trim(Left(FirstPart, InStr(FirstPart, "-") - 1)))
LastNum = Val(Trim(Mid(FirstPart, InStr(FirstPart, "-") + 1)))
For NumCount = FirstNum To LastNum
If NumCount <> FirstNum Then
NewStr = NewStr & ", " & NumCount
Else
NewStr = NewStr & NumCount
End If
Next NumCount
Else
NewStr = NewStr & FirstPart
End If
Loop
Range("A" & RowCount) = "(" & NewStr & ")"
End If
RowCount = RowCount + 1
Loop

End Sub