Copy down text in columns until next part number - VBA Code

[CC268]

Hey guys, see my two attached photos. The first photo shows what it currently looks like (a very small sample of the actual thing) and the second photo shows what I want it to look like. I simply want to copy down the NHA No, NHA Description, and NHA Rev columns down until the next part number and then repeat. Is there a way to do this in VBA?

Thanks!

1801518016

[ties]

this should do the trick


Option Explicit

Sub copyDownHeaders()
Dim sht As Worksheet
Dim lastRow As Long
Dim curRow As Long
Dim headerRow As Long

Set sht = ThisWorkbook.Worksheets("Sheet1")
'edit to your sheetname ------

lastRow = sht.Cells(sht.Rows.Count, 4).End(xlUp).Row
headerRow = 1

For curRow = 2 To lastRow
If sht.Cells(curRow, 1) = "" Then
sht.Cells(curRow, 1) = sht.Cells(headerRow, 1)
sht.Cells(curRow, 2) = sht.Cells(headerRow, 2)
sht.Cells(curRow, 3) = sht.Cells(headerRow, 3)
Else
headerRow = curRow
End If
Next curRow
End Sub

[CC268]

this should do the trick


Option Explicit

Sub copyDownHeaders()
Dim sht As Worksheet
Dim lastRow As Long
Dim curRow As Long
Dim headerRow As Long

Set sht = ThisWorkbook.Worksheets("Sheet1")
'edit to your sheetname ------

lastRow = sht.Cells(sht.Rows.Count, 4).End(xlUp).Row
headerRow = 1

For curRow = 2 To lastRow
If sht.Cells(curRow, 1) = "" Then
sht.Cells(curRow, 1) = sht.Cells(headerRow, 1)
sht.Cells(curRow, 2) = sht.Cells(headerRow, 2)
sht.Cells(curRow, 3) = sht.Cells(headerRow, 3)
Else
headerRow = curRow
End If
Next curRow
End Sub


That worked! Thanks so much!

I don't know if you have time - but would you mind commenting on the code so I know what is going on? Just for my own learning sake...

[snb]

Please do not quote !
In VBA:


Sub M_snb()
for each it in sheet1.cells(1).currentregion.columns(1).specialcells(4).areas
it.resize(,3).value=it.cells(1).offset(-1).resize(,3).value
next
end sub

[CC268]

Sorry

[ties]

The same code, now with comments added


Option Explicit

Sub copyDownHeaders()
Dim sht As Worksheet
Dim lastRow As Long
Dim curRow As Long
Dim headerRow As Long

Set sht = ThisWorkbook.Worksheets("Sheet1")
'edit to your sheetname ------

'sht.rows is a collection of all the rows in the sheet
'sht.rows.count=1048576 (the number of rows in the sheet)
'the range.end(direction) method moves in the specified direction
'from the (first) cel in the range to a 'opposite' cel is encountered
'so it ends up in row 15 column 4 (D)

'the cells(r,c) method addresses the cel in row r column c

lastRow = sht.Cells(sht.Rows.Count, 4).End(xlUp).Row
headerRow = 1 'remember where the headers are

For curRow = 2 To lastRow 'walk through all the rows

If sht.Cells(curRow, 1) = "" Then
'it is not a header
'set 3 columns to value in header row
sht.Cells(curRow, 1) = sht.Cells(headerRow, 1)
sht.Cells(curRow, 2) = sht.Cells(headerRow, 2)
sht.Cells(curRow, 3) = sht.Cells(headerRow, 3)

Else
'it is a header row, so now cells must be filled from this row
headerRow = curRow
End If

Next curRow
End Sub