Copy/Paste variable length rows

[srfeldman]

I have read several similar posts, but none seem to work for what I'm doing. Seems simple, yet I can't figure it out. I have thousands of rows in a spreadsheet and 150 unique id's in col. A. The rows that follow each unique number are variable. For example, empl. 502 has 26 rows, followed by empl. 316 that has 4 rows. I want to copy 502 to the next 26 rows, then 316 to the 4 rows after 316, and so on for the 150 unique id's and rows that follow. Any help is greatly appreciated. Thanks!

 

[Max1616]

Are the cells in column A below the employee# blank?

Also, does the last row that is populated in column B represent that last row of the data set?

 

[Fluff]

Try this

Sub FillDwn()

    Dim Ar As Areas
    Dim a As Range

    Set Ar = Range("A1:A" & Range("B" & Rows.Count).End(xlUp).Row).SpecialCells(xlBlanks).Areas
    For Each a In Ar
        a.Offset(-1).Resize(a.Rows.Count + 1).Filldown
    Next a

End Sub

 

[Max1616]

If what I asked is true, I would use this:

Sub PopulateIDs()

Dim lrow As Long
Dim lrow2 As Long
Dim srow As Long
Dim i As Long
Dim ID As String

lrow = Cells(Rows.Count, 1).End(xlUp).Row
lrow2 = Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To lrow2
    If Cells(i, 1) <> "" Then
        ID = Cells(i, 1)
        srow = i
    End If
        
    If Cells(i + 1, 1) <> "" Then Range(Cells(srow, 1), Cells(i, 1)) = ID
    If i = lrow2 Then Range(Cells(srow, 1), Cells(i, 1)) = ID

Next i

End Sub

 

[srfeldman]

Yes. I believe rows below are blank. Cols C-J are populated with the data. Col. B is the employee name which is also blank after the first occurrence, same as Col. A.

 

[Fluff]

Yes. I believe rows below are blank. Cols C-J are populated with the data. Col. B is the employee name which is also blank after the first occurrence, same as Col. A.

With this in mind, slight change to my code

Sub FillDwn()

    Dim Ar As Areas
    Dim a As Range

    Set Ar = Range("A1:A" & Range("C" & Rows.Count).End(xlUp).Row).SpecialCells(xlBlanks).Areas
    For Each a In Ar
        a.Offset(-1).Resize(a.Rows.Count + 1).Filldown
    Next a

End Sub

 

[srfeldman]

Awesome Max!! Thanks so much. Immense time suck now a push of a button.

 

[Max1616]

Fluff, great idea using areas, I didn't consider that. That is a much more elegant solution than mine!

 

[Fluff]

Fluff, great idea using areas, I didn't consider that. That is a much more elegant solution than mine!

It's not something I use that often &, therefore, tend to forget about it.
I just happened to see someone using it earlier, which is what made me think of it.
Nice bit of luck

 

[Rick Rothstein]

Awesome Max!! Thanks so much. Immense time suck now a push of a button.

You can also do what you want without using a loop...

[table="width: 500"]
[tr]
	[td]Sub FillInTheMissingIDs()
  With Range("A1:A" & Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row)
    .SpecialCells(xlBlanks).FormulaR1C1 = "=R[-1]C"
    .Value = .Value
  End With
End Sub[/td]
[/tr]
[/table]