View Full Version : Copy down text in columns until next part number - VBA Code
CC268
01-12-2017, 02:26 PM
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
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
01-12-2017, 03:34 PM
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...
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
01-12-2017, 04:22 PM
Sorry
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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.