Duplicate rows based on cell content and identifying primary value

Question

I'm looking for exactly this operation: How do I duplicate rows based on cell contents (cell contains semi-colon seperated data)

But with an added column: Starting table vs End result

What I have:

| Name   | Size       | Photo   |
|--------|------------|---------|
| Tshirt | 10, 12, 14 | 144.jpg |
| Jeans  | 30, 40, 42 | 209.jpg |
| Dress  | 8          | 584.jpg |
| Shoe   | 6          | 178.jpg |

What I would like:

| Name   | Size | Photo   | Primary |
|--------|------|---------|---------|
| Tshirt | 10   | 144.jpg | 1       |
| Tshirt | 12   | 144.jpg | 0       |
| Tshirt | 14   | 144.jpg | 0       |
| Jeans  | 30   | 209.jpg | 1       |
| Jeans  | 40   | 209.jpg | 0       |
| Jeans  | 42   | 209.jpg | 0       |
| Dress  | 8    | 584.jpg | 1       |
| Shoe   | 6    | 178.jpg | 1       |

Right now the code I found works perfectly but I don't know how to add the "Primary" column.

Sub SplitCell()
Dim cArray As Variant
Dim cValue As String
Dim rowIndex As Integer, strIndex As Integer, destRow As Integer
Dim targetColumn As Integer
Dim lastRow As Long, lastCol As Long
Dim srcSheet As Worksheet, destSheet As Worksheet

targetColumn = 2 'column with semi-colon separated data

Set srcSheet = ThisWorkbook.Worksheets("Sheet1") 'sheet with data
Set destSheet = ThisWorkbook.Worksheets("Sheet2") 'sheet where result will be displayed

destRow = 0
With srcSheet
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    For rowIndex = 1 To lastRow
        cValue = .Cells(rowIndex, targetColumn).Value 'getting the cell with semi-colon separated data
        cArray = Split(cValue, ";") 'splitting semi-colon separated data in an array
        For strIndex = 0 To UBound(cArray)
            destRow = destRow + 1
            destSheet.Cells(destRow, 1) = .Cells(rowIndex, 1)
            destSheet.Cells(destRow, 2) = Trim(cArray(strIndex))
            destSheet.Cells(destRow, 3) = .Cells(rowIndex, 3)
        Next strIndex
    Next rowIndex
End With
End Sub

Thanks for your help!

Michał Turczyn · Accepted Answer · 2018-03-14T14:50:10.597

2

Try this slight modification of your code, you'll have to declare additional variable Dim priority As Boolean:

For rowIndex = 1 To lastRow
    cValue = .Cells(rowIndex, targetColumn).Value 'getting the cell with semi-colon separated data
    cArray = Split(cValue, ";") 'splitting semi-colon separated data in an array
    priority = True
    For strIndex = 0 To UBound(cArray)
        destRow = destRow + 1
        destSheet.Cells(destRow, 1) = .Cells(rowIndex, 1)
        destSheet.Cells(destRow, 2) = Trim(cArray(strIndex))
        destSheet.Cells(destRow, 3) = .Cells(rowIndex, 3)
        destSheet.Cells(destRow, 4) = IIf(priority, 1, 0)
        priority = False
    Next strIndex
Next rowIndex

edited Mar 14 '18 at 14:50

answered Mar 14 '18 at 13:27

Michał Turczyn

32,028
14
47
69

Won't it be better simply to `dim priority as Long` and in order to avoid `-CInt(priority)` which looks tough. Then to say `priority = 1` and `priorty = 0` instaed of `priority = True` and `priority = False` ? The understanding would be improved. – Vityata Mar 14 '18 at 14:23
@Vityata Well, that was my first idea, but I have chosen current one, as it's slightly more memory-efficient (I know it's not the case) – Michał Turczyn Mar 14 '18 at 14:43
@Charles You could try solution with `priority` instead of `-CInt(priority)`, then it would display `True` instead of one and `False` instead of zero if you'd like. – Michał Turczyn Mar 14 '18 at 14:45
@MichałTurczyn - what is slightly more memory-efficient? Declaring `boolean` instead of `Long`? – Vityata Mar 14 '18 at 14:45
@Vityata Yes, i guess so, as it takes less space. Check out edited answet, is it better? – Michał Turczyn Mar 14 '18 at 14:45
@MichałTurczyn - the space should be irrelevant, `long` is 32 bit and in all the Operation Systems after the last 20 years it is the native value - https://stackoverflow.com/questions/26409117/why-use-integer-instead-of-long. But actually the `Boolean` is slightly faster, tried some loops to see. The `Iif` is better to understand. – Vityata Mar 14 '18 at 15:05

SJR · Answer 2 · 2018-03-14T13:13:46.343

Here is a slightly different approach, which avoids the second loop.

Sub SplitCell()

Dim cArray As Variant
Dim rowIndex As Long, destRow As Long
Dim targetColumn As Long
Dim lastRow As Long, lastCol As Long
Dim srcSheet As Worksheet, destSheet As Worksheet

targetColumn = 2 'column with semi-colon separated data

Set srcSheet = ThisWorkbook.Worksheets("Sheet1") 'sheet with data
Set destSheet = ThisWorkbook.Worksheets("Sheet2") 'sheet where result will be displayed
destRow = 1
With srcSheet
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    destSheet.Cells(1, 4).Value = "Primary"
    For rowIndex = 1 To lastRow
        cArray = Split(srcSheet.Cells(rowIndex, targetColumn), ";") 'splitting semi-colon separated data in an array
        destSheet.Cells(destRow, 1).Resize(UBound(cArray) + 1).Value = srcSheet.Cells(rowIndex, targetColumn - 1).Value
        destSheet.Cells(destRow, 2).Resize(UBound(cArray) + 1).Value = Application.Transpose(cArray)
        destSheet.Cells(destRow, 3).Resize(UBound(cArray) + 1).Value = srcSheet.Cells(rowIndex, targetColumn + 1).Value
        If rowIndex > 1 Then destSheet.Cells(destRow, 4).Value = 1
        If UBound(cArray) > 0 Then
            destSheet.Cells(destRow + 1, 4).Resize(UBound(cArray)).Value = 0
        End If
        destRow = destSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
    Next rowIndex
End With

End Sub

score 0 · Answer 3 · answered Mar 14 '18 at 13:10

Note: I am using this "," delimiter as your data shows that rather than your code which is using ";". Simply swop if necessary.

Option Explicit

Sub SplitCell()
    Dim cArray As Variant
    Dim cValue As String
    Dim rowIndex As Long, strIndex As Long, destRow As Long
    Dim targetColumn As Long
    Dim lastRow As Long, lastCol As Long
    Dim srcSheet As Worksheet, destSheet As Worksheet

    targetColumn = 2                             'column with semi-colon separated data

    Set srcSheet = ThisWorkbook.Worksheets("Sheet1") 'sheet with data
    Set destSheet = ThisWorkbook.Worksheets("Sheet2") 'sheet where result will be displayed

    destRow = 0

    With srcSheet

        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

        For rowIndex = 1 To lastRow

            cValue = .Cells(rowIndex, targetColumn).Value 'getting the cell with semi-colon separated data
            cArray = Split(cValue, ",")          'splitting semi-colon separated data in an array

            For strIndex = 0 To UBound(cArray)

                destRow = destRow + 1
                destSheet.Cells(destRow, 1) = .Cells(rowIndex, 1)
                destSheet.Cells(destRow, 2) = Trim(cArray(strIndex))
                destSheet.Cells(destRow, 3) = .Cells(rowIndex, 3)

                If rowIndex = 1 Then

                   destSheet.Cells(destRow, 4) = "Primary"

                Else
                    If strIndex = 0 Then
                        destSheet.Cells(destRow, 4) = 1
                    Else
                        destSheet.Cells(destRow, 4) = 0
                    End If
                End If

            Next strIndex

        Next rowIndex

    End With
End Sub

DisplayName · Answer 4 · 2018-03-14T14:38:07.033

your whole sub can boil down to:

Sub SplitCell()
    Dim vals As Variant
    vals = ThisWorkbook.Worksheets("Sheet001").Range("A1").CurrentRegion.value

    Dim iVal As Long
    With ThisWorkbook.Worksheets("Sheet002")
        .Range("A1:C1").value = Application.index(vals, 1, 0)
        .Range("D1").value = "Primary"
        For iVal = 2 To UBound(vals)
            With .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(Split(vals(iVal, 2) & ",", ",")))
                .Offset(, 0).value = vals(iVal, 1)
                .Offset(, 1).value = Application.Transpose(Split(vals(iVal, 2) & ",", ","))
                .Offset(, 2).value = vals(iVal, 3)
                .Offset(, 3).value = Application.Transpose(Split("1," & String(.Rows.Count - 1, ","), ","))
            End With
        Next
        .Range("D1", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeBlanks).value = 0
    End With
End Sub

Duplicate rows based on cell content and identifying primary value

4 Answers4