CODEWITHSUNDEEP
vbaexcelsplitstring-concatenation
haber-er
haber-er

Reputation: 75

Finding the last letter in the cell

I have multiple rows of strings that are both text and numbers. I want to do a text to columns that separates this by spaces except for the first and last parts.

If I run the text to columns delimited by spaces then it splits up strings that I don't want split up.

Example:

Quarterly Performance Numbers 999,999.99 12.00 1.00 2.00 3.00 4.00 Dec 09, 2013

Becomes:

Quarterly|Performance|Numbers|999,999.99|12.00|1.00|2.00|3.00|4.00|Dec|09,|2013

What I want:

Quarterly Performance Numbers|999,999.99|12.00|1.00|2.00|3.00|4.00|Dec 09, 2013

The problem is the part is varying lengths and number of words (anywhere from 3 to 6).

Is there a way I can create text qualifiers around those two strings in VBA?

Sub Macro3()


Dim i As Integer
Dim LastRow As Long

LastRow = ActiveSheet.UsedRange.Rows.Count

For i = 1 To LastRow

Cells(i, 2).Value = Mid(Cells(i, 1), 29, 37)
Cells(i, 3).Value = Right(Cells(i, 1), 12)
Cells(i, 1).Value = Left(Cells(i, 1), 37)

Next i


End Sub

Upvotes: 0

Views: 703

Answers (2)

haber-er
haber-er

Reputation: 75

I figured out a way that works. As I was warned, RegEx ended up being more of a problem than a solution. My method isn't pretty but it gets the job done. I count the number of spaces by subtracting the length of the string by the length of the string after I remove the spaces. The only variable in spaces comes from the number of spaces in the description and so if i subtract the 8 minimum spaces from the total spaces i can use it to replace the Nth space with ";". I do this 7 times and all of my columns come out correctly in delimited text to columns. Thanks everyone. Sorry if my explanation sucks.

Sub Macro14()

Dim i As Long
Dim smaller As String
Dim spaces As Integer
Dim fixed As String
Dim LastRow As Long

LastRow = ActiveSheet.UsedRange.Rows.Count

For i = 1 To LastRow

smaller = Replace(Cells(i, 1), " ", "")
spaces = Len(Cells(i, 1)) - Len(smaller) - 8

fixed = Cells(i, 1).Value
fixed = WorksheetFunction.Substitute(fixed, " ", ";", spaces) 'after desc
fixed = WorksheetFunction.Substitute(fixed, " ", ";", spaces) 'after value
fixed = WorksheetFunction.Substitute(fixed, " ", ";", spaces) 'after %age
fixed = WorksheetFunction.Substitute(fixed, " ", ";", spaces) 'after first perf column
fixed = WorksheetFunction.Substitute(fixed, " ", ";", spaces) 'after second perf column
fixed = WorksheetFunction.Substitute(fixed, " ", ";", spaces) 'after third perf column
fixed = WorksheetFunction.Substitute(fixed, " ", ";", spaces) 'after fourth perf column/before the date

Cells(i, 1).Value = fixed

Next i

End Sub

Upvotes: 0

omegastripes
omegastripes

Reputation: 12612

Sub Test()
    Dim sContent, oMatch, arrParsed(), sResult
    sContent = "Quarterly Performance Numbers 999,999.99 12.00 1.00 2.00 3.00 4.00 Dec 09, 2013"
    arrParsed = Array()
    With New RegExp ' Tools - References - add "Microsoft VBScript Regular Expressions 5.5" or use With CreateObject("VBScript.RegExp")
        .Pattern = "(?:(?:[a-z ]+(?= )){3,6}|(?:-*[\d,.]+(?= ))|(?:[a-z]{3} \d{2}, \d{4}))"
        .Global = True
        .IgnoreCase = True
        For Each oMatch In .Execute(sContent)
            ReDim Preserve arrParsed(UBound(arrParsed) + 1)
            arrParsed(UBound(arrParsed)) = oMatch.Value
        Next
    End With
    ' here you can use arrParsed
    sResult = Join(arrParsed, ";")
    MsgBox sResult
End Sub

Upvotes: 1

Related Questions