Partially parse a cell

[Krisdw]

I have a column of data with anywhere from one to 50 countries in it. I would like to test the contents and parse only the first 20 countries. If there were more than 20, I'd just like to replace the value with "more than 20 countries". Is any way other than parsing it to some other location and then copying back?

Could I somehow first count the occurences of the delimiter and if it is above some threshold then replace the value?


' Parse Country
Columns("BK:CE").Select
Selection.Insert Shift:=xlToRight
Selection.TextToColumns Destination:=Range("BJ1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

Actual data in cell:
<table border="0" cellpadding="0" cellspacing="0" width="64"><col width="64"><tbody><tr height="17"> <td style="height: 12.75pt; width: 48pt;" height="17" width="64">United States;Switzerland;Australia;Austria;New Zealand;Philippines;Singapore;Thailand;Belgium;Luxembourg;Netherlands;Canada;China;Hong Kong;India;Malaysia;Indonesia;Japan;Korea;Pakistan;Taiwan;Vietnam;Saudi Arabi;United Arab Emirates (Abu Dhabi;Croatia;Czech Republic;Germany;Denmark;USA;United Kingdom;France;Estonia;Egypt;Swaziland;Spain;Georgia;Greece;Hungary;Ireland;Israel;Lebanon;Latvia;Lithuania;Norway;Sweden;Finland;Portugal;Russia;Slovakia;Slovenia;Turkey;Ukraine;South Africa;Argentina;Brazil;Chile;Colombia;Costa Rica;Dominican Republic;Ecuador;Guatemala;Honduras;Mexico;Nicaragua;Panama;Paraguay;Peru;Uruguay;Venezuela;El Salvador</td> </tr></tbody></table>

 

[taigovinda]

Welcome to the board!

If the values are in column A and there is nothing in the way (the next 20 columns) then maybe:

Sub test()
Dim checkArr, rngCel As Range
For Each rngCel In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    checkArr = Split(rngCel.Value, ";")
    If UBound(checkArr) < 19 And UBound(checkArr) > 0 Then
        rngCel.Resize(1, UBound(checkArr) + 1).Value = checkArr
    End If
Next
End Sub

...split() will put the cell value into an array with ";" as the delimiter. Then based on the size of the array it will put the array across the row or else do nothing. Hope that helps.

 

[Krisdw]

Thank you. Does this mean that anything over the 20 just gets ignored?

 

[taigovinda]

Oh yeah, you're right... could change to overwrite over 20 like this (will overwrite the cell, not leaving the countries' names):

Sub test()
Dim checkArr, rngCel As Range
For Each rngCel In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    checkArr = Split(rngCel.Value, ";")
    If UBound(checkArr) < 19 And UBound(checkArr) > 0 Then
        rngCel.Resize(1, UBound(checkArr) + 1).Value = checkArr
    Else If UBound(checkArr) > 0 Then
       rngCel.Value = "more than 20 countries."
   End If
Next
End Sub

Try running it on a copy of your data and see if it does what you want.

 

[Krisdw]

Works perfectly! Just what I needed. Thank you!