none
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
                    Me.Rows(iRow).Insert
                    For i = 1 To 7
                        Me.Cells(iRow, i).Value = sCell(i)
                    Next i
                Next j
            End If
            iRow = iRow + 1
        Loop
    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)
                        Else
                            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
    Answerer