Splitting text into the row below with changing delimiters

[revershed]

Hi,

Was wondering if someone could help me at all? I have the following in an excel sheet.

Column A
Software defect;#19
Software defect;#19;#Capacity;#2
Software defect;#19;#Capacity;#2;#Monitoring & tools;#14

What I'd like to do is:

1) remove the # and number i.e. #2, #14 & #19 in this example
2) Split the cells with multiple values. Take the second row down for example

Software defect;#19;#Capacity;#2

Would like to place this into the row below. The end goal is that it looks like this:

Software defect
Capacity

Any help, advice would greatly be appreciated.

Richard

 

[hiker95]

revershed,

Welcome to the MrExcel forum.


Sample raw data before the macro:

Excel Workbook
	A
1	Software defect;#19
2	Software defect;#19;#Capacity;#2
3	Software defect;#19;#Capacity;#2;#Monitoring & tools;#14
4
Sheet1

After the macro:

Excel Workbook
	A
1	Software defect
2	Software defect
3	Capacity
4	Software defect
5	Capacity
6	Monitoring & tools
7
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub SplitData()
' hiker95, 04/10/2011
' http://www.mrexcel.com/forum/showthread.php?t=542516
Dim LR As Long, a As Long, aa As Long
Dim Sp, s As Long, ss As Long
Application.ScreenUpdating = False
LR = Cells(Rows.Count, 1).End(xlUp).Row
For a = LR To 1 Step -1
  On Error GoTo ErrorRoutine
  Sp = Split(Cells(a, 1), ";#")
  If UBound(Sp) = 1 Then
    Cells(a, 1) = Sp(0)
  ElseIf UBound(Sp) = 3 Then
    s = UBound(Sp) - 2
    Rows(a + 1).Resize(s).Insert
    aa = a - 1
    For ss = LBound(Sp) To UBound(Sp)
      If Not IsNumeric(Sp(ss)) Then
        aa = aa + 1
        Cells(aa, 1) = Sp(ss)
      End If
    Next ss
  ElseIf UBound(Sp) = 5 Then
    s = UBound(Sp) - 3
    Rows(a + 1).Resize(s).Insert
    aa = a - 1
    For ss = LBound(Sp) To UBound(Sp)
      If Not IsNumeric(Sp(ss)) Then
        aa = aa + 1
        Cells(aa, 1) = Sp(ss)
      End If
    Next ss
  ElseIf UBound(Sp) = 7 Then
    s = UBound(Sp) - 4
    Rows(a + 1).Resize(s).Insert
    aa = a - 1
    For ss = LBound(Sp) To UBound(Sp)
      If Not IsNumeric(Sp(ss)) Then
        aa = aa + 1
        Cells(aa, 1) = Sp(ss)
      End If
    Next ss
  ElseIf UBound(Sp) = 9 Then
    s = UBound(Sp) - 5
    Rows(a + 1).Resize(s).Insert
    aa = a - 1
    For ss = LBound(Sp) To UBound(Sp)
      If Not IsNumeric(Sp(ss)) Then
        aa = aa + 1
        Cells(aa, 1) = Sp(ss)
      End If
    Next ss
  End If
ErrorRoutine:
On Error GoTo 0
Next a
Application.ScreenUpdating = True
End Sub

Then run the SplitData macro.

 

[hiker95]

revershed,

If you can have the results in a new worksheet, then this should work for any length text string in column A.


Sample raw data in worksheet Sheet1:

Excel Workbook
	A
1	Software defect;#19
2	Software defect;#19;#Capacity;#2
3	Software defect;#19;#Capacity;#2;#Monitoring & tools;#14
4
Sheet1

After the macro in a new worksheet Results:

Excel Workbook
	A
1	Software defect
2	Software defect
3	Capacity
4	Software defect
5	Capacity
6	Monitoring & tools
7
Results

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub SplitDataV2()
' hiker95, 04/10/2011
' http://www.mrexcel.com/forum/showthread.php?t=542516
Dim w1 As Worksheet, wR As Worksheet
Dim Sp, c As Range, s As Long, NR As Long
Application.ScreenUpdating = False
Set w1 = Worksheets("Sheet1")
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wR = Worksheets("Results")
wR.UsedRange.Clear
Set wR = Worksheets("Results")
NR = 0
For Each c In w1.Range("A1", w1.Range("A" & Rows.Count).End(xlUp))
  If InStr(c, "#") > 0 Then
    Sp = Split(c, ";#")
    For s = LBound(Sp) To UBound(Sp)
      If Not IsNumeric(Sp(s)) Then
        NR = NR + 1
        wR.Range("A" & NR) = Sp(s)
      End If
    Next s
  End If
Next c
wR.Columns(1).AutoFit
wR.Activate
Application.ScreenUpdating = False
End Sub

Then run the SplitDataV2 macro.

 

[revershed]

Wow, awesome! Thank you so much.