Instantly share code, notes, and snippets.

Embed
What would you like to do?
Excel Macro To Create Rows From Column Data
Private Sub NewData_Click()
'Select sheet by name
Sheets("OriginalData").Select
'Get total rows in column 'a'
RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
'Select range from K2 to O and clear contents
Range("K2:O" & RowCount).Select
Selection.ClearContents
'Variable to determin a new row
NewRow = 0
'Loop from second row until end
For i = 2 To RowCount
'Grab required values and assigned to variables
Range("A" & i).Select
ClassName = Range("A" & (ActiveCell.Row)).Value
'If content is empty then finish loop
If ClassName = "" Then Exit Sub
YearGroup = Range("B" & (ActiveCell.Row)).Value
StudentName = Range("C" & (ActiveCell.Row)).Value
Ver = Range("D" & (ActiveCell.Row)).Value
Quan = Range("E" & (ActiveCell.Row)).Value
NVR = Range("F" & (ActiveCell.Row)).Value
'Apply values for first column requirement 'Ver' to new cells but increasing row count
Range("K" & i).Select
Range("K" & (ActiveCell.Row + NewRow)).Value = ClassName
Range("L" & i).Select
Range("L" & (ActiveCell.Row + NewRow)).Value = YearGroup
Range("M" & i).Select
Range("M" & (ActiveCell.Row + NewRow)).Value = StudentName
Range("N" & i).Select
Range("N" & (ActiveCell.Row + NewRow)).Value = Ver
Range("O" & i).Select
Range("O" & (ActiveCell.Row + NewRow)).Value = "Ver"
'Apply values for second column requirement 'Quan' to new cells but increasing row count
Range("K" & i).Select
Range("K" & (ActiveCell.Row + NewRow + 1)).Value = ClassName
Range("L" & i).Select
Range("L" & (ActiveCell.Row + NewRow + 1)).Value = YearGroup
Range("M" & i).Select
Range("M" & (ActiveCell.Row + NewRow + 1)).Value = StudentName
Range("N" & i).Select
Range("N" & (ActiveCell.Row + NewRow + 1)).Value = Quan
Range("O" & (ActiveCell.Row + NewRow + 1)).Value = "Quan"
'Apply values for first column requirement 'NVR' to new cells but increasing row count
Range("K" & i).Select
Range("K" & (ActiveCell.Row + NewRow + 2)).Value = ClassName
Range("L" & i).Select
Range("L" & (ActiveCell.Row + NewRow + 2)).Value = YearGroup
Range("M" & i).Select
Range("M" & (ActiveCell.Row + NewRow + 2)).Value = StudentName
Range("N" & i).Select
Range("N" & (ActiveCell.Row + NewRow + 2)).Value = NVR
Range("O" & (ActiveCell.Row + NewRow + 2)).Value = "NVR"
'Ensure that row count increases correctly so that all columns are converted to new rows
NewRow = NewRow + 2
Next
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment