Skip to content

Instantly share code, notes, and snippets.

Last active February 16, 2021 00:24
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
What would you like to do?
This script loops BACKWARDS through a block of data, applying logic and noting which rows mandate a new row insert. It then loops through the collected "insert" rows, applying the final logic
Option Explicit
Public Sub InsertNewRowsBasedOnValues()
Dim wksData As Worksheet
Dim lngLastRow As Long, lngIdx As Long, _
lngStudentCol As Long, lngItemCol As Long, lngNetAmtCol As Long, _
lngPreviousAmtCol As Long, lngNewAmtCol As Long, _
lngReversalCol As Long
Dim varRowNum As Variant
Dim colRowNumsForInsert As Collection
Set colRowNumsForInsert = New Collection
'Set references up-front
lngStudentCol = 1
lngItemCol = 2
lngNetAmtCol = 3
lngPreviousAmtCol = 4
lngNewAmtCol = 5
lngReversalCol = 6
Set wksData = ThisWorkbook.Worksheets("Sheet1")
lngLastRow = LastOccupiedRowNum(wksData)
'Loop through the data range BACKWARDS, tracking each
'case where a row will need to be in a collection
With wksData
For lngIdx = lngLastRow To 2 Step -1
'On every loop, we ALWAYS:
' 1. set the New Amount value to the Previous Amount value
' 2. set the Reversal to "Y"
.Cells(lngIdx, lngNewAmtCol) = .Cells(lngIdx, lngPreviousAmtCol)
.Cells(lngIdx, lngReversalCol) = "Y"
'If the Net Amount is > 0, though, we also need
'to note that row number so we can eventually add
'a new row there
If .Cells(lngIdx, lngNetAmtCol) > 0 Then
colRowNumsForInsert.Add Item:=lngIdx, Key:=CStr(lngIdx)
End If
Next lngIdx
'Nice! We have done a lot of data prep already -- we just need
'to add rows where necessary and apply the right values
'Loop through the row numbers in our collection, which
'are conveniently in REVERSE order (as adding rows will
'change the row numbers in the range, making forward looping
'very difficult
For Each varRowNum In colRowNumsForInsert
'First, insert a new row, shifting everything below it down
.Range("A" & varRowNum).Offset(1).EntireRow.Insert Shift:=xlDown
'Write the Student and Item numbers (which are the same)
.Cells(varRowNum + 1, lngStudentCol) = .Cells(varRowNum, lngStudentCol)
.Cells(varRowNum + 1, lngItemCol) = .Cells(varRowNum, lngItemCol)
'Write the New Amount (which is the Net Amount from the
'row above)
.Cells(varRowNum + 1, lngNewAmtCol) = .Cells(varRowNum, lngNetAmtCol)
'Write the Reversal to "N"
.Cells(varRowNum + 1, lngReversalCol) = "N"
Next varRowNum
End With
'Let the user know the script is done
MsgBox "Finished!"
End Sub
'INPUT : Sheet, the worksheet we'll search to find the last row
'OUTPUT : Long, the last occupied row
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
Dim lng As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
With Sheet
lng = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
End With
lng = 1
End If
LastOccupiedRowNum = lng
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment