[mso] Re: Excel-A Tough One
- From: "Green" <1z@xxxxxxxxxxxxxx>
- To: <mso@xxxxxxxxxxxxx>
- Date: Tue, 4 Nov 2008 02:20:41 +0100
Cool Code Hutch!!
> Try this macro. It pauses & asks you to select the input
> range (cells with data to be split). Then it pauses a second
> time & asks you to select one cell (must be on the same
> sheet) where the output should start.
>
> Sub SplitData()
> Dim InRng As Range, OutRng As Range, c As Range Dim CumOffset
> As Long, x As Long, y As Long Dim TmpStr As String, Fillem As
> Boolean Dim CurrItem As String, CurrNbr As String Dim
> StartFill As Long, EndFill As Long Dim NbrArray() As Long
> Application.InputBox("Select the cells to be split",
> Type:=8).Select Set InRng = Selection 'Output must be on same
> sheet as input Application.InputBox("Select the starting cell
> for output", Type:=8).Select Set OutRng = Selection For Each
> c In InRng
> If Len(c.Value) > 0 Then
> TmpStr = c.Value & ","
> ReDim NbrArray(0)
> CurrNbr = vbNullString
> StartFill = 0
> EndFill = 0
> Fillem = False
> CurrItem = Trim(Left(TmpStr, InStr(1, TmpStr, " ")))
> For x = 1 To Len(TmpStr)
> Select Case Mid(TmpStr, x, 1)
> Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
> CurrNbr = CurrNbr & Mid(TmpStr, x, 1)
> Case ","
> If Fillem = False Then
> ReDim Preserve NbrArray(UBound(NbrArray) + 1)
> NbrArray(UBound(NbrArray)) = CLng(CurrNbr)
> Else
> EndFill = CLng(CurrNbr)
> For y = StartFill To EndFill
> ReDim Preserve NbrArray(UBound(NbrArray) + 1)
> NbrArray(UBound(NbrArray)) = y
> Next y
> End If
> CurrNbr = vbNullString
> Case "-"
> StartFill = CLng(CurrNbr)
> Fillem = True
> CurrNbr = vbNullString
> Case Else
> 'do nothing
> End Select
> Next x
> For x = (LBound(NbrArray) + 1) To UBound(NbrArray)
> OutRng.Offset(CumOffset, 0).Value = CurrItem & "
> " & NbrArray(x)
> CumOffset = CumOffset + 1
> Next x
> End If
> Next c
> cleanup:
> Set InRng = Nothing
> Set OutRng = Nothing
> ReDim NbrArray(0)
> End Sub
> If you are new to macros, this link to Jon Peltier's site may
> be helpful:
> http://peltiertech.com/WordPress/2008/03/09/how-to-use-someone
> -elses-macro/
>
> Hope this helps,
>
> Hutch
*************************************************************
You are receiving this mail because you subscribed to mso@xxxxxxxxxxxxx or
MicrosoftOffice@xxxxxxxxxxxxxxxx
To send mail to the group, simply address it to mso@xxxxxxxxxxxxx
To Unsubscribe from this group, visit the group's homepage and use the dropdown
menu at the top. This will allow you to unsubscribe your email address or
change your email settings to digest or vacation (no mail).
//www.freelists.org/webpage/mso
To be able to share files with the group, you must join our Yahoo sister group.
This group will not allow for posting of emails, but will allow you to join
and share problem files, templates, etc.:
http://tech.groups.yahoo.com/group/MicrosoftOffice . This group is for FILE
SHARING ONLY.
If you are using Outlook and you see a lot of unnecessary code in your email
messages, read these instructions that explain why and how to fix it:
http://personal-computer-tutor.com/abc3/v28/greg28.htm
*************************************************************
Other related posts:
