0

I have a text string that I would like to split using VBA. I cannot figure out how to output it in the format desired.

The objective is to split each of the 5 strings into an array, but the For loop I have created just splits the same string over and over.

The idea is to split each string by it's equipment information, so it can be dumped into an FTP Upload excel sheet.

This is the code I have currently:

Sub Break_String()
    Dim WrdArray() As String
    Dim text_string As String
    Dim intCount As Integer, intCounter As Integer
    Dim o As Object

    For intCount = 1 To 6
        text_string = Cells(intCount, 2)
        WrdArray() = Split(text_string, "EQ # : ")
    Next intCount

    Set o = CreateObject("excel.application")
    o.Visible = True
    o.Workbooks.Open ("NER FTP UPLOADER.xlsm")

    For intCount = 1 To 6
        o.Sheets("sheet1").Range("B19:F25").Value = WrdArray()
    Next intCount
End Sub

And this is the source data:

UNITED RENTALS EQUIP#(s) & DESCRIPTION: ** **EQ # : 10045597**YR: 2012          **MAKE: KENT**MODEL: KF 4 SS**SERIAL/VIN #: 1984**TYPE OF EQUIPMENT: SKID STEER/MINI EXCAVATOR BREAKER**ORIGINAL EQUIPMENT COST: 3832.71**
UNITED RENTALS EQUIP#(s) & DESCRIPTION: ** **EQ # : 10251995**YR:  2015         **MAKE: STIHL**MODEL: TS420:14**SERIAL/VIN #: 177734255**TYPE OF EQUIPMENT: CUT OFF SAW**ORIGINAL EQUIPMENT COST: 730.00** **EQ # : 10353520**YR:  2015         **MAKE: DEWALT**MODEL: D25980K**SERIAL/VIN #: 007379**TYPE OF EQUIPMENT: DEMO HAMMER**ORIGINAL EQUIPMENT COST: 1118.78** ** **EQ # : 10326567**YR:  2015         **MAKE: HILTI**MODEL: TE60:ATC**SERIAL/VIN #: 71248**TYPE OF EQUIPMENT: ROTARY HAMMER**ORIGINAL EQUIPMENT COST: 1115.49** ** **EQ # : 10335480**YR:  2015         **MAKE: STIHL**MODEL: TS420**SERIAL/VIN #: 179146608**TYPE OF EQUIPMENT: CUT OFF SAW**ORIGINAL EQUIPMENT COST: 824.96** **EQ # : 10331620**YR:  2014         **MAKE: DEWALT**MODEL: D25980K**SERIAL/VIN #: 006159**TYPE OF EQUIPMENT: DEMO HAMMER**ORIGINAL EQUIPMENT COST: 1117.42**
UNITED RENTALS EQUIP#(s) & DESCRIPTION: ** **EQ # : 10189822**YR:  2013         **MAKE: MULTIQUIP**MODEL: DCA70SSJU4I**SERIAL/VIN #: 7305316**TYPE OF EQUIPMENT: GENERATOR**ORIGINAL EQUIPMENT COST: 33068.65
UNITED RENTALS EQUIP#(s) & DESCRIPTION: ** **EQ # : 1226605**YR: 2011          **MAKE: MULTIQUIP**MODEL: GAW180HE1**SERIAL/VIN #: 5653875**TYPE OF EQUIPMENT: WELDER**ORIGINAL EQUIPMENT COST: 2442.03
UNITED RENTALS EQUIP#(s) & DESCRIPTION: ** **EQ # : 1219041**YR: 2011          **MAKE: WACKER**MODEL: BS 60:2I**SERIAL/VIN #: 20036780**TYPE OF EQUIPMENT: RAMMER**ORIGINAL EQUIPMENT COST: 2642.09
UNITED RENTALS EQUIP#(s) & DESCRIPTION: ** **EQ # : 10391557**YR: 2015          **MAKE: WACKER**MODEL: WP1550AW**SERIAL/VIN #: 30101214**TYPE OF EQUIPMENT: VIB PLATE**ORIGINAL EQUIPMENT COST: 1499.52** **EQ # : 10305672**YR: 2014          **MAKE: TOW MASTER**MODEL: T:5DT**SERIAL/VIN #: 4KNTT1210FL160572**Lic. Plate**: MO / 63E0HL**TYPE OF EQUIPMENT: TRAILER**ORIGINAL EQUIPMENT COST: 4887.14**
Improve this question
0

2 Answers 2

Reset to default
1

The problem that you are having is one of logic. The first "For" loop will run 6 times, each time overwriting "WrdArray()" so that at the end of the loop it is equal to the final value.

The second "For" loop is pasting this final value into 6 different cells.

To fix this, reorder the code:

Sub Break_String()
    Dim WrdArray() As String
    Dim text_string As String
    Dim intCount As Integer, intCounter As Integer
    Dim o As Object

    Set o = CreateObject("excel.application")
    o.Visible = True
    o.Workbooks.Open ("NER FTP UPLOADER.xlsm")


    For intCount = 1 To 6

        text_string = sheets("mySheet").Cells(intCount, 2)
        WrdArray() = Split(text_string, "EQ # : ")
        o.Sheets("sheet1").Range("B" & (18 + intCount) & ":F" & (18+intCount)).Value = WrdArray()

    Next intCount


End Sub

Notice that you also need to change the cells you are pasting to in the loop, otherwise the data will just overwrite.

Alternatively, you could use an array of arrays:

Sub Break_String()
    Dim arArrays() As Variant
    Dim WrdArray() As String
    Dim text_string As String
    Dim intCount As Integer, intCounter As Integer
    Dim o As Object

    ReDim arArrays(1 To 6)

        For intCount = 1 To 6

            text_string = sheets("mySheet").Cells(intCount, 2)
            WrdArray() = Split(text_string, "EQ # : ")
            arArrays(intCount) = WrdArray()

         Next intCount

    Set o = CreateObject("excel.application")
    o.Visible = True
    o.Workbooks.Open ("NER FTP UPLOADER.xlsm")

    For intCount = 1 To 6

        o.Sheets("sheet1").Range("B" & (18 + intCount) & ":F" & (18+intCount)).Value = arArrays(intCount)

    Next intCount

End Sub

EDIT*** Fixed error in line assigning values from array to the cell. Needed to add ":" to the range. Also changed "24" to "18" as the results should all be on the same row.

While fixing this, noticed that "Cells(intCount, 2)" was not referencing a worksheet. Updated to reference a worksheet, but the correct worksheet name should be added here, not "mySheet."

EDIT2***

Sub Break_String()
    Dim WrdArray() As String
    Dim text_string As String
    Dim intCount As Integer, intCounter As Integer
    Dim o As Object
    Dim pasteRow As Integer
    Dim i As Integer

    pasteRow = 19

    Set o = CreateObject("excel.application")
    o.Visible = True
    o.Workbooks.Open ("NER FTP UPLOADER.xlsm")


    For intCount = 1 To 6

        text_string = sheets("mySheet").Cells(intCount, 2)
        WrdArray() = Split(text_string, "EQ # : ")
        For i = LBound(WrdArray) to UBound(WrdArray)
            o.Sheets("sheet1").Range("B" & (pasteRow)).Value = WrdArray[i]
            pasteRow = pasteRow + 1
        Next i
    Next intCount


End Sub

This will do as asked in the comments.

Improve this answer
Sign up to request clarification or add additional context in comments.

7 Comments

Thank you! I appreciate your assistance. I am running into an error when running the code, line o.Sheets("sheet1").Range("B" & (18 + intCount) & "F" & (24 + intCount)).Value = WrdArray() gives me "application-defined or object-defined error. What does this mean/how can I fix it?
See Edit. I didn't test this and forgot the ":" in the range. Also, 24 needs to be changed to 18 (as I assume you want each row to represent one record). Also, added worksheet reference to the original cell reference. Change from "mysheet" to the name of your sheet.
Looking good now, all the data is in the correct order and place. Thank you for that. One last question for you. Once the string has been split, the second and third strings of the split are put in the column next to the first split. Is there a way to put it directly below the string that was split? This would allow me to keep the split data in the correct order so it can be grouped.
So you want to change each row into 3 rows, with one row for the first part of the split and then another row beneath it for the second and then third parts of the split, so in the end you would have 18 rows?
Since the strings have an undefined number of splits, the best solution would be to have it look to see how many splits there are, and drop those splits into the row directly below the 1st split (and then continue to the next string). Some strings are just one split long, while others are unpredictable. The longest string is currently 5 splits long, but I can't say how many the future strings may have. The data comes in from an outside source so I can't alter it, but the data is a batch of equipment descriptions from one event, so keeping them together is important.
|
1

Try adding this: Sheets("Sheet1").Range("C" & intCount & ":G" & intCount).Value = WrdArray() under this: WrdArray() = Split(text_string, "EQ # : ") This will give you an idea of how to see the results of each split, and should make it easy for you to figure it out from there.

Improve this answer

1 Comment

This is more of a comment than an answer as it does not address the underlying issues in this code, namely the improper usage of loops and arrays.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.