I am trying to make a macro that will look at text in the active cell. Based on the separator (comma, semi, backslash, etc) I want it to split the data and put each separated peice into it's own row. Right now it is putting each piece in it's own cell , but it is overwriting the data below.
What I'd like is for it insert X number of rows (x being the number of separators) and then split the data and insert it into the new rows. The original cells can stay as is, it doesn't have to be trimmed.
My data:
Column A: names of people (1 value per cell)
Column B: dates (1 value per cell)
Column C: part # (should be 1 value per cell. Sometimes it is up to 30!)
Column D: color (again, should be 1 but could be 30)
Column E: quantity (1 value per cell)
Column F: names of places
My current script:
Sub TextToRows()
Sep = InputBox("Enter the separator type", "Separator")
If Sep = "" Then Exit Sub
For Each Cell In Selection
wholeRow = CStr(Cell.Value)
If Right(wholeRow, 1) <> Sep Then
wholeRow = wholeRow & Sep
End If
RowNum = 0
Pos = 1
NextPos = InStr(Pos, wholeRow, Sep)
While NextPos >= 1
TempVal = Mid(wholeRow, Pos, NextPos - Pos)
Cell.Offset(RowNum, 0).Value = TempVal
Pos = NextPos + 1
RowNum = RowNum + 1
NextPos = InStr(Pos, wholeRow, Sep)
Wend
Next
End Sub
What I'd like is for it insert X number of rows (x being the number of separators) and then split the data and insert it into the new rows. The original cells can stay as is, it doesn't have to be trimmed.
My data:
Column A: names of people (1 value per cell)
Column B: dates (1 value per cell)
Column C: part # (should be 1 value per cell. Sometimes it is up to 30!)
Column D: color (again, should be 1 but could be 30)
Column E: quantity (1 value per cell)
Column F: names of places
My current script:
Sub TextToRows()
Sep = InputBox("Enter the separator type", "Separator")
If Sep = "" Then Exit Sub
For Each Cell In Selection
wholeRow = CStr(Cell.Value)
If Right(wholeRow, 1) <> Sep Then
wholeRow = wholeRow & Sep
End If
RowNum = 0
Pos = 1
NextPos = InStr(Pos, wholeRow, Sep)
While NextPos >= 1
TempVal = Mid(wholeRow, Pos, NextPos - Pos)
Cell.Offset(RowNum, 0).Value = TempVal
Pos = NextPos + 1
RowNum = RowNum + 1
NextPos = InStr(Pos, wholeRow, Sep)
Wend
Next
End Sub