John Carney
asked on
Macro that will distribute numbers, some of which are shown as ranges, to cells
Please take a look at the attached workbook. I have a file that contains multiple numbers in each cell in a range of 40+ cells . Some of the numbers are expressed as ranges with a dash. I need a macro that will distribute each individual number, stated or implied, to its own cell.
Thanks,
John
DistributeNumbers.xls
Thanks,
John
DistributeNumbers.xls
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Hey, I'm just getting started! And you ... you are as smart as you are a smart-ass!
Thank you. :-)
John
Thank you. :-)
John
ASKER
Thanks Kevin. Hey, if I'm not pushing my luck (which of course is one of the things I do best) ... if you could toss off a little macro, that would be awesome. I just like to see the little numbers populate and I've had this issue with arrays ever since I was in first grade.
ASKER
"Please re-write the description using better punctuation, spelling, and grammar." You and I have to go to a biker bar sometime and see how long it takes us to get beat up. :-)
Can I bring my buddy Steve? He's a badass Italian MF who has a nice gun collection.
Because I love you so damn much I made an even better UDF that doesn't display "#N/A" and displays "More..." in the last formula cell if there isn't enough room.
Public Function ExpandNumberSequence(ByVal Source As String) As Variant
Dim Tokens As Variant
Dim Token As Variant
Dim SubTokens As Variant
Dim Index As Long
Dim Result As Variant
Dim More As Boolean
Result = Array()
Tokens = Split(Source, ",")
For Each Token In Tokens
SubTokens = Split(Trim(Token), "-")
If UBound(SubTokens) = 0 Then
ReDim Preserve Result(0 To UBound(Result) + 1)
Result(UBound(Result)) = Val(SubTokens(0))
Else
For Index = SubTokens(0) To SubTokens(1)
ReDim Preserve Result(0 To UBound(Result) + 1)
Result(UBound(Result)) = Index
Next
End If
Next Token
If Application.Caller.Columns .Count < UBound(Result) + 1 Then More = True
ReDim Preserve Result(0 To Application.Caller.Columns .Count - 1)
For Index = 0 To UBound(Result)
If IsEmpty(Result(Index)) Then
Result(Index) = vbNullString
End If
Next Index
If More Then
Result(UBound(Result)) = "More..."
End If
ExpandNumberSequence = Result
End Function
Kevin
Public Function ExpandNumberSequence(ByVal
Dim Tokens As Variant
Dim Token As Variant
Dim SubTokens As Variant
Dim Index As Long
Dim Result As Variant
Dim More As Boolean
Result = Array()
Tokens = Split(Source, ",")
For Each Token In Tokens
SubTokens = Split(Trim(Token), "-")
If UBound(SubTokens) = 0 Then
ReDim Preserve Result(0 To UBound(Result) + 1)
Result(UBound(Result)) = Val(SubTokens(0))
Else
For Index = SubTokens(0) To SubTokens(1)
ReDim Preserve Result(0 To UBound(Result) + 1)
Result(UBound(Result)) = Index
Next
End If
Next Token
If Application.Caller.Columns
ReDim Preserve Result(0 To Application.Caller.Columns
For Index = 0 To UBound(Result)
If IsEmpty(Result(Index)) Then
Result(Index) = vbNullString
End If
Next Index
If More Then
Result(UBound(Result)) = "More..."
End If
ExpandNumberSequence = Result
End Function
Kevin
1,917 question so far! Jeez!