Text to Columns Code

[Sheryl]

I need to write code for Text to Columns for the cells I select and they
would always be in the same column, but could be any column. Each cell
contains one or more underscores, but I need it split up at the second
underscore. I don't have a clue on how to write this, can you help?
Example starting with would be:
First-Set-Of-Words_SecondSet_ThirdSet
I need:
First Column Second Column
First-Set-Of-Words_SecondSet ThirdSet
I need this split between the second and third set dropping the second
underscore too and to remain as text format.

 

[Joel]

MyWord = "First-Set-Of-Words_SecondSet_ThirdSet"
First_Underscore = InStr(MyWord, "_")
Second_Underscore = InStr(First_Underscore + 1, MyWord, "_")
FirstWord = Left(MyWord, Second_Underscore - 1)
SecondWord = Mid(MyWord, Second_Underscore + 1)
Range("A1") = FirstWord
Range("B1") = SecondWord

 

[Joel]

Here is a more complete solution

Sub fixcolumn()

firstcol = "D"
For Each cell In Columns(firstcol)
If cell <> "" Then
First_Underscore = InStr(cell, "_")
Second_Underscore = InStr(First_Underscore + 1, cell, "_")
If Second_Underscore > 0 Then
FirstWord = Left(cell, Second_Underscore - 1)
SecondWord = Mid(cell, Second_Underscore + 1)
cell = FirstWord
cell.Offset(0, 1) = SecondWord
End If
End If
Next cell

 

[Sheryl]

Wow, I don't think I had a chance to blink before you responded. Awesome
response time. My code is stopping at the
If cell <> "" Then
I haven't messed with much code lately and don't know where to begin to get
this to run. Am I missing something I need to add?

 

[Joel]

The fix is easy

from
For Each cell In Columns(firstcol)
to
For Each cell In Range(firstcol)

 

[Joel]

You didn't specify the column so I used D. Change this as necessary