TextToColumns - OtherChar _ :="_"

[DownUnder71]

Hello Forum,

In a cell I have "ABCDEFG_0123_78_82". I'd like keep "ABCDEFG_0123" in a cell in column A, the "78" in column B, and the "82" in column C. Using the the VBA code below, I'm unable to keep the first "_" intact (i.e. ABCDEFG_0123).

Selection.TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="_", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
TrailingMinusNumbers:=True

So I need something to start the separation process from the second "_". Any help would be greatly appreciated.

Thanks in advance.

 

[6StringJazzer]

There is no way to do this within the TextToColumns method. Do you always want to keep the first "_" in every cell you do this? If so, first loop through all cells to do a "replace" to replace the first instance of "_" with some other oddball character that is not otherwise used, like "$". Then do your text-to-columns, then loop back through to change "$" back to "_".

 

[mikerickson]

Would a length based TextToColumns work or is your data variable in that regard?

 

[Rick Rothstein]

Here is a macro that will do what you asked for the contents of Column A (starting at Row 2)...

[table="width: 500"]
[tr]
	[td]Sub SpecialTextToColumns()
  With Range("A2", Cells(Rows.Count, "A").End(xlUp))
    .Offset(, 1) = Evaluate(Replace("IF(@="""","""",SUBSTITUTE(SUBSTITUTE(@,""_"","",""),"","",""_"",1))", "@", .Address))
    .Offset(, 1).TextToColumns , xlDelimited, , , False, False, True, False, False
  End With
End Sub[/td]
[/tr]
[/table]

 

[DownUnder71]

Thanks very much for your input gents.

I'm definitely not an Excel guru but, I understand, to some extent :-/, what all of you are saying.

So here's the whole macro:

Sub Separate_Sort()
'
' Separate_Sort Macro


Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="_", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
TrailingMinusNumbers:=True
Range("C2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.TextToColumns Destination:=Range("C2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=".", FieldInfo:=Array(Array(1, 1), Array(2, 9)), TrailingMinusNumbers:=True
Range("A1:C1").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.Worksheets("Check Sheet").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Check Sheet").Sort.SortFields.Add Key:=Range( _
"A2:A2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Check Sheet").Sort.SortFields.Add Key:=Range( _
"B2:B2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Check Sheet").Sort
.SetRange Range("A1:C2000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub


So, if I have the following in column 'A' and starting in cell A2:

ABCDEFG_0123_0_2.jpg
ABCDEFG_0123_2_4.jpg
ABCDEFG_0123_4_6.jpg
ABCDEFG_0123_6_8.jpg
ABCDEFG_0123_8_10.jpg
ABCDEFG_0123_10_12.jpg



I'd like it to end up looking like this:

Column A

 

[DownUnder71]

...sorry, bit of an issue before I could finish my last post.

So, if I have the following in column 'A' and starting in cell A2:

ABCDEFG_0123_0_2.jpg
ABCDEFG_0123_2_4.jpg
ABCDEFG_0123_4_6.jpg
ABCDEFG_0123_6_8.jpg
ABCDEFG_0123_8_10.jpg
ABCDEFG_0123_10_12.jpg


I'd like it to end up looking like this:

Column A Column B Column C
ABCDEFG_0123 0 2
ABCDEFG_0123 2 4
ABCDEFG_0123 4 6
ABCDEFG_0123 6 8
ABCDEFG_0123 8 10
ABCDEFG_0123 10 12


The first underscore needs to be retained as it is linked and is checked against an external database.

N.B. The macro above works fine for something like WXYZ01234567_0_2.jpg

Again, thanks very much for your help.

 

[Rick Rothstein]

N.B. The macro above works fine for something like WXYZ01234567_0_2.jpg

I think you may be indicating that my code did not work with your actual data. The reason for that is the examples you posted were not representative of your actual data (you neglected to mention that the text in the cells ended with a dot and file extension that you did not want to keep). Here is my macro modified to do what you have now told us you want...

[table="width: 500"]
[tr]
	[td]Sub SpecialTextToColumns()
  With Range("A2", Cells(Rows.Count, "A").End(xlUp))
    .Offset(, 1) = Evaluate(Replace("IF(@="""","""",SUBSTITUTE(SUBSTITUTE(LEFT(@,FIND(""."",@)-1),""_"","",""),"","",""_"",1))", "@", .Address))
    .Offset(, 1).TextToColumns , xlDelimited, , , False, False, True, False, False
  End With
End Sub[/td]
[/tr]
[/table]

 

[mikerickson]

Try this

Sub Macro1()
    With Range("A:A")
        .TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(12, 1))
        .Offset(0, 1).TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
            :="_", FieldInfo:=Array(Array(1, 9), Array(2, 1), Array(3, 1))
        .Offset(0, 2).TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
            :=".", FieldInfo:=Array(Array(1, 1), Array(2, 9))
    End With
End Sub