VBA assistance to separate out strings between semi colons in cells and copy each individually - see example below RRS feed

  • Question

  • Hello,

    I have a program that copies an entire row dependent upon how many semi colons found in a column.
    The format of the column can be AAA;BBB;CCC When result after the program is run is 

    row 1 AAA;BBB;CCC
    row 2 AAA;BBB;CCC
    row 3 AAA;BBB;CCC

    What I would like to happen is it to end up as so

    row 1 AAA
    row 2 BBB
    row 3 CCC

    The code I have so far is below. Thank you in advance for any suggestions.

    Const ROW_FIRST As Integer = 1
    Private Const ROW_LAST As Integer = 100

    Sub CopySemi

    Dim iRow As Integer, iRowsAdded As Integer, iSemicolons As Integer, i As Integer, j As Integer
        Dim sCell(1 To 7) As String
        iRow = ROW_FIRST
        Do While iRow < ROW_LAST + iRowsAdded
            For i = 1 To 7
                sCell(i) = Me.Cells(iRow, i).Value
            Next i
            iSemicolons = Len(sCell(2)) - Len(Replace(sCell(2), ";", ""))
            If iSemicolons > 0 Then
                For j = 1 To iSemicolons
                    iRow = iRow + 1
                    For i = 1 To 7
                        Me.Cells(iRow, i).Value = sCell(i)
                    Next i
                Next j
            End If
            iRow = iRow + 1
    End Sub

    Thank you.

    Thursday, November 15, 2012 10:35 PM

All replies

  • Try this:

    Sub CopySemi()
        Dim iRow As Integer, i As Integer, j As Integer
        Dim arr
        For iRow = ROW_LAST To ROW_FIRST Step -1
            arr = Split(Me.Cells(iRow, 2).Value, ";")
            If UBound(arr) > 0 Then
                For j = UBound(arr) To 1 Step -1
                    Rows(iRow + 1).Insert
                    For i = 1 To 7
                        If i = 2 Then
                            Me.Cells(iRow + 1, i).Value = arr(j)
                            Me.Cells(iRow + 1, i).Value = Cells(iRow, i).Value
                        End If
                    Next i
                Next j
                Me.Cells(iRow, 2) = arr(0)
            End If
        Next iRow
    End Sub

    Regards, Hans Vogelaar

    Thursday, November 15, 2012 11:04 PM
  • Hello,

    Thank you so much. Actually after further testing I am getting 1004 error.

    it is highlighting  "arr = Split(Cells(iRow, 2).Value, ";")"

    In the beginning of the code it has Dim arr, should that be As ???. Thank you.

    • Edited by tyantorno Saturday, November 17, 2012 12:59 AM
    Friday, November 16, 2012 12:53 AM
  • Dear tyantorno,

    If any post solves your issue, pls try marking as answer.This will help others in finding answer for similar problem quickly...

    Best Regards,
    Asadulla Javed, Kolkata
    Please do not forget to click “Vote as Helpful” if any post helps you and "Mark as Answer”if it solves the issue.

    Friday, November 16, 2012 5:53 AM