CODEWITHSUNDEEP
vbaexcel
Charles
Charles

Reputation: 57

Duplicate rows based on cell content and identifying primary value

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!

Upvotes: 2

Views: 125

Answers (4)

Michał Turczyn
Michał Turczyn

Reputation: 37347

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

Upvotes: 2

DisplayName
DisplayName

Reputation: 13386

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

Upvotes: 0

SJR
SJR

Reputation: 23081

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

Upvotes: 0

QHarr
QHarr

Reputation: 84465

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

Upvotes: 0

Related Questions