Unconsolidate Rows in Excel 2016

[kevinmcgarry90]

Hello Gurus,

I am currently trying to break oneline summaries into many rows. Basically, on one tab, I have one line for each subject. This line says how many events that subject had. I want to have another tab that creates rows for each subject and event. The desired look is below, I just didn't extrapolate the values all the way down to save space. I'd like it to automatically move from one subject to the next when the previous subject is out of lines to make. So basically, performing the exact opposite function is easy yet I can't figure out how to get it to unconsolidated.

Original Table

WELL #	# STAGES
9	77
10	77
11	77
12	77
13	77

<colgroup><col width="64" style="width:48pt" span="2"> </colgroup><tbody>
</tbody>

Desired Output on Different Tab

WELL	STAGE
9	1
9	2
10	1
10	2
11	1
11	2
12	1
12	2

<colgroup><col width="64" style="width:48pt" span="2"> </colgroup><tbody>
</tbody>

Thanks for the help!

 

[Fluff]

Hi & welcome to the board.
Is this what you're after

Sub UnconsolidateData()

   Dim Cl As Range
   Dim UsdRws As Long
   
   
   With Sheets("[COLOR=#ff0000]Sheet2[/COLOR]")
      .Range("A1:B1").Value = Sheets("[COLOR=#0000ff]Sheet1[/COLOR]").Range("A1:B1").Value
      For Each Cl In Sheets("[COLOR=#0000ff]Sheet1[/COLOR]").Range("A2", Sheets("[COLOR=#0000ff]Sheet1[/COLOR]").Range("A" & Rows.Count).End(xlUp))
         UsdRws = .Range("A" & Rows.Count).End(xlUp).Offset(1).Row
         .Range("A" & UsdRws).Resize(1 * Cl.Offset(, 1)).Value = Cl.Value
         .Range("B" & UsdRws).Value = 1
         .Range("B" & UsdRws).AutoFill Range("B" & UsdRws).Resize(Cl.Offset(, 1)), xlFillSeries
      Next Cl
   End With

End Sub

Change sheet names to suit

 

[kevinmcgarry90]

Hi & welcome to the board.
Is this what you're after

Sub UnconsolidateData()

   Dim Cl As Range
   Dim UsdRws As Long
   
   
   With Sheets("[COLOR=#ff0000]Sheet2[/COLOR]")
      .Range("A1:B1").Value = Sheets("[COLOR=#0000ff]Sheet1[/COLOR]").Range("A1:B1").Value
      For Each Cl In Sheets("[COLOR=#0000ff]Sheet1[/COLOR]").Range("A2", Sheets("[COLOR=#0000ff]Sheet1[/COLOR]").Range("A" & Rows.Count).End(xlUp))
         UsdRws = .Range("A" & Rows.Count).End(xlUp).Offset(1).Row
         .Range("A" & UsdRws).Resize(1 * Cl.Offset(, 1)).Value = Cl.Value
         .Range("B" & UsdRws).Value = 1
         .Range("B" & UsdRws).AutoFill Range("B" & UsdRws).Resize(Cl.Offset(, 1)), xlFillSeries
      Next Cl
   End With

End Sub

Change sheet names to suit

Thank you! This is very close! It does exactly what I want it to do if my data was in those ranges. As such, my sheet1 data begins on C3:D3 and my sheet2 area begins on C14:D14. When I modify the code to accommodate these changes, it doesn't work for the first well value. It just returns one line for the first subject and then begins the count for the rest of the subjects. Do you know how I could modify to prevent this?

well	stage
9	5
10	1
10	2
10	3
10	4
10	5
11	1
11	2
11	3
11	4
11	5
12	1
12	2
12	3
12	4
12	5
13	1
13	2
13	3
13	4
13	5

<colgroup><col width="64" style="width: 48pt;" span="2"> <tbody> </tbody>

 

[Fluff]

Try this

Sub UnconsolidateData()

   Dim Cl As Range
   Dim UsdRws As Long
   
   With Sheets("Sheet2")
      .Range("C14:D14").Value = Sheets("Sheet1").Range("C3:D3").Value
      For Each Cl In Sheets("Sheet1").Range("C4", Sheets("Sheet1").Range("C" & Rows.Count).End(xlUp))
         UsdRws = .Range("C" & Rows.Count).End(xlUp).Offset(1).Row
         .Range("C" & UsdRws).Resize(1 * Cl.Offset(, 1)).Value = Cl.Value
         .Range("D" & UsdRws).Value = 1
         If Cl.Offset(, 1) > 1 Then
            .Range("D" & UsdRws).AutoFill .Range("D" & UsdRws).Resize(Cl.Offset(, 1)), xlFillSeries
         End If
      Next Cl
   End With

End Sub

 

[kevinmcgarry90]

OK, it wasn't working because I didn't think to exclude the title blocks from the row counting. After playing with it, this is the final code that does exactly what I was hoping for. Thank you so much!!

Sub UnconsolidateData()
Dim Cl As Range
Dim UsdRws As Long

With Sheets("Sheet2")
.Range("C13:D13").Value = Sheets("Sheet1").Range("C2:D2").Value
For Each Cl In Sheets("Sheet1").Range("C3", Sheets("Sheet1").Range("C" & Rows.Count).End(xlUp))
UsdRws = .Range("C" & Rows.Count).End(xlUp).Offset(1).Row
.Range("C" & UsdRws).Resize(1 * Cl.Offset(, 1)).Value = Cl.Value
.Range("D" & UsdRws).Value = 1
If Cl.Offset(, 1) > 1 Then
.Range("D" & UsdRws).AutoFill .Range("D" & UsdRws).Resize(Cl.Offset(, 1)), xlFillSeries
End If
Next Cl
End With
End Sub

 

[Fluff]

Glad you got it working & thanks for the feedback