Last active
February 16, 2021 00:24
-
-
Save danwagnerco/afdb8f95a66d84c80515d5db688a9e7e to your computer and use it in GitHub Desktop.
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
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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, _ | |
MatchCase:=False).Row | |
End With | |
Else | |
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