CODEWITHSUNDEEP
vbaexcel
Cstansell2199
Cstansell2199

Reputation: 35

Splitting Single Excel Row to Multiple Rows

I'm working on a variation of this question:
Split single row into multiple rows based on cell value in excel

In the old question, the poster wanted a new row to start with each cell that contained a specific value. I'm wondering if there is any way to start a new row after a cell that contains a specific value?

I have adjusted the linked code for my use and it works perfectly, but it's creating a new row one cell too early for my data. The original question was about a year and a half old, and has an accepted answer so I didn't know if commenting on it would get a response.

If that's not correct protocol for the site I apologize. Any help would be greatly appreciated!

Dim rngColLoop As Range
Dim rngSheet1  As Range
Dim wksSheet2  As Worksheet
Dim intColCounter  As Integer
Dim intRowCounter  As Integer

Sheets.Add.Name = "Sheet2"

With Worksheets("2014-2633")
    Set rngSheet1 = .Range(.Range("R1"), .Range("R1").End(xlToRight))
End With

Set wksSheet2 = Worksheets("Sheet2")
intRowCounter = 1
intColCounter = 0

wksSheet2.Range("A1").CurrentRegion.Clear

With rngSheet1
    For Each rngColLoop In .Columns
        If Trim(rngColLoop) <> "" Then
            If (Trim(rngColLoop)) <> "TennesseeSigned" Then
                intColCounter = intColCounter + 1
                wksSheet2.Cells(intRowCounter, intColCounter) = rngColLoop
            ElseIf (Trim(rngColLoop)) = "TennesseeSigned" Then
                intRowCounter = intRowCounter + 1
                intColCounter = 1
                wksSheet2.Cells(intRowCounter, intColCounter) = rngColLoop
            End If
        End If
    Next rngColLoop
End With

Set rngColLoop = Nothing
Set rngSheet1 = Nothing
Set wksSheet2 = Nothing

Upvotes: 1

Views: 186

Answers (1)

ib11
ib11

Reputation: 2568

A simplistic approach is to detect the change and set a Boolean variable. Then test this variable to do the change, in the next loop cycle, like so:

Dim rngColLoop As Range
Dim rngSheet1  As Range
Dim wksSheet2  As Worksheet
Dim intColCounter  As Integer
Dim intRowCounter  As Integer
Dim isNewRowRequired As Boolean: isNewRowRequired = False

Sheets.Add.Name = "Sheet2"

With Worksheets("2014-2633")
    Set rngSheet1 = .Range(.Range("R1"), .Range("R1").End(xlToRight))
End With

Set wksSheet2 = Worksheets("Sheet2")
intRowCounter = 1
intColCounter = 0

wksSheet2.Range("A1").CurrentRegion.Clear

With rngSheet1
    For Each rngColLoop In .Columns
        If Trim(rngColLoop) <> "" Then
            'See if the Bolean was set to true in the previous loop cycle
            If isNewRowRequired Then
                intRowCounter = intRowCounter + 1
                intColCounter = 1
                wksSheet2.Cells(intRowCounter, intColCounter) = rngColLoop
                isNewRowRequired = False
            Else
                'If not, carry on as usual (even if the cell value is matching)
                intColCounter = intColCounter + 1
                wksSheet2.Cells(intRowCounter, intColCounter) = rngColLoop
            End If
            'If value is matching, now set the Boolean to true 
            'so the break can be made in the next loop cycle
            If (Trim(rngColLoop)) = "TennesseeSigned" Then
                isNewRowRequired = True
            End If
        End If
    Next rngColLoop
End With

Set rngColLoop = Nothing
Set rngSheet1 = Nothing
Set wksSheet2 = Nothing

Hope this helps.

Upvotes: 1

Related Questions