Text to rows...at wits end

[SanFranGuy06]

Hi all,

I've gotten some really great help here before and I'm hoping I'll be
able to get some again because I'm at wits end. I'm trying to get a
script to do text to rows. The following is how my spread sheet
looks...a few hundred rows of cells with data points separated by
commas:

Accel Partners, Weber Capital Management, LLC, Invesco Private Capital,
MeriTech Capital Partners, Oak Investment Partners, Technology
Crossover Ventures, Venrock Associates, Doll Capital Management,
Telefonos de Mexico SA de CV (NYSE:TMX), Whitman Capital, LLC, AT&T
Inc. (NYSE:T), Alcatel (ENXTPA:CGE), Shell Internet Ventures BV,
Pilgrim Baxter Hybrid Partners, Lake Street Capital LLC

I'm looking for each one to be on separated onto it's own row, i.e.

accel partners
weber capital management
invesco private capital
etc.

Can someone please help? i've been staring at this for over an hour now
and getting nowhere fast! Thanks so much in advance!!

 

[SanFranGuy06]

So this is what I have so far, but it craps out at this line...

..Cells(lngRow + 1, intCurrent_and_Pending_InvestorsCol) = Mid(strTemp,
intPos + 1, intPosEnd - intPos - 1) & Right(strTemp, 4)


Sub Text_to_rows()

Dim lngRow As Long
Dim strTemp As String
Dim intPos As Integer
Dim intPosEnd As Integer
Dim lngRow2 As Long
Dim intCurrent_and_Pending_InvestorsCol As Integer

intCurrent_and_Pending_InvestorsCol = 5
lngRow = 11
With ActiveSheet
Do While .Cells(lngRow, intCurrent_and_Pending_InvestorsCol) <>
""
lngRow2 = lngRow
strTemp = .Cells(lngRow,
intCurrent_and_Pending_InvestorsCol)
intPos = InStr(strTemp, ",")
If intPos > 0 Then
intPosEnd = InStr(intPos, strTemp, ",")
If intPosEnd > 0 Then
lngRow2 = lngRow2 + 1
.Rows(lngRow).Copy
.Rows(lngRow).Insert Shift:=xlDown
.Cells(lngRow + 1,
intCurrent_and_Pending_InvestorsCol) = Mid(strTemp, intPos + 1,
intPosEnd - intPos - 1) & Right(strTemp, 4)
strTemp = Left(strTemp, intPos -
intCurrent_and_Pending_InvestorsCol) & Trim(Mid(strTemp, intPosEnd +
1))
.Cells(lngRow, intCurrent_and_Pending_InvestorsCol)
= strTemp
End If
End If
intPos = InStr(strTemp, "(")
If intPos > 0 Then
intPosEnd = InStr(intPos, strTemp, ")")
If intPosEnd > 0 Then
lngRow2 = lngRow2 + 1
.Rows(lngRow).Copy
.Rows(lngRow).Insert Shift:=xlDown
.Cells(lngRow + 1,
intCurrent_and_Pending_InvestorsCol) = Mid(strTemp, intPos + 1,
intPosEnd - intPos - 1) & Right(strTemp, 4)
strTemp = Left(strTemp, intPos - 1) &
Trim(Mid(strTemp, intPosEnd + 1))
.Cells(lngRow, intCurrent_and_Pending_InvestorsCol)
= strTemp
End If
End If
lngRow = lngRow2 + 1
Loop
End With
End Sub

 

[HSalim[MVP]]

You would be better off replacing the commas before importing the data into
Excel.
Excel is not well suited to this (yes, you could make it do it) and
You could do some really neat text parsing with Regular Expressions.

Regular expressions is a part of VBA, so you really don't have to move too
far away from Excel.

I suspect what you want to do is a lot more than what you hve posted here.
Could you post a sanitized and abridged copy of your source file here?

HS

 

[NickHK]

Here's one of many ways. You could improve efficiency of the concatenation
if many elements will be involved. Also, I think the element limit on
Transpose is as indicated, but test.
Depending on the exact structure of your data, you may have use:
str = str & Temp & " "
then
OutArray = Split(str, ", ")

Private Sub CommandButton1_Click()
Dim RetVal As Long
Dim AllData As Variant

RetVal = FixArray(Range("rngData"), AllData)

If RetVal > 5461 Then
MsgBox "Too many elements. Can't Transpose with Excel"
Else
Range("A1").Offset(0, 2).Resize(RetVal, 1).Value =
Application.Transpose(AllData)
End If

End Sub

Private Function FixArray(InArray As Variant, ByRef OutArray As Variant) As
Long
Dim Temp As Variant
Dim str As String

For Each Temp In InArray
str = str & Temp
Next

OutArray = Split(str, ",")

FixArray = UBound(OutArray)

End Function

NickHK