Simple Tweak In Excel VBA to Insert a new row if condition meets

Jyotirmaya

Board Regular
Joined
Dec 2, 2015
Messages
168
Option Explicit

Sub InsertRowBelowNegativeEntriesInFGHI()

Dim lLastColRow As Long
Dim lLastRow As Long
Dim lColIndex As Long
Dim lRowIndex As Long
Dim bInsert As Boolean
Dim bIsBalanceRow As Boolean
Dim vFPos As Variant
Dim vGPos As Variant
Dim vHPos As Variant
Dim vIPos As Variant
Dim vJPos As Variant
Dim vKPos As Variant
Dim vLPos As Variant
Dim vMPos As Variant
Dim vNPos As Variant
Dim vOPos As Variant
Dim vPPos As Variant
Dim vQPos As Variant
Dim vRPos As Variant
Dim vSPos As Variant
Dim vTPos As Variant
Dim sTrigger As String

For lColIndex = 6 To 10
lLastColRow = Cells(Rows.Count, lColIndex).End(xlUp).Row
If lLastColRow > lLastRow Then lLastRow = lLastColRow
Next

For lRowIndex = lLastRow - 1 To 2 Step -1
If UCase(Cells(lRowIndex, 1).Value) = "BALANCE" Then
'On a BALANCE row
bInsert = False
vFPos = Cells(lRowIndex, "F").Value
vGPos = Cells(lRowIndex, "G").Value
vHPos = Cells(lRowIndex, "H").Value
vIPos = Cells(lRowIndex, "I").Value
vJPos = Cells(lRowIndex, "J").Value

If vFPos < 0 And (vGPos > 0 Or vHPos > 0 Or vIPos > 0 Or vJPos > 0) Then bInsert = True: 'sTrigger = "F"
If vGPos < 0 And (vHPos > 0 Or vIPos > 0 Or vJPos > 0) Then bInsert = True: 'sTrigger = "G"
If vHPos < 0 And (vIPos > 0 Or vJPos > 0) Then bInsert = True: 'sTrigger = "H"
If vIPos < 0 And (vJPos > 0) Then bInsert = True: 'sTrigger = "I"

If bInsert Then
Cells(lRowIndex + 1, 1).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
'Debug.Print lRowIndex, sTrigger
End If

End If
Next
For lColIndex = 11 To 15
lLastColRow = Cells(Rows.Count, lColIndex).End(xlUp).Row
If lLastColRow > lLastRow Then lLastRow = lLastColRow
Next

For lRowIndex = lLastRow - 1 To 2 Step -1
If UCase(Cells(lRowIndex, 1).Value) = "BALANCE" Then
'On a BALANCE row
bInsert = False
vKPos = Cells(lRowIndex, "K").Value
vLPos = Cells(lRowIndex, "L").Value
vMPos = Cells(lRowIndex, "M").Value
vNPos = Cells(lRowIndex, "N").Value
vOPos = Cells(lRowIndex, "O").Value

If vKPos < 0 And (vLPos > 0 Or vMPos > 0 Or vNPos > 0 Or vOPos > 0) Then bInsert = True: 'sTrigger = "K"
If vLPos < 0 And (vMPos > 0 Or vNPos > 0 Or vOPos > 0) Then bInsert = True: 'sTrigger = "L"
If vMPos < 0 And (vNPos > 0 Or vOPos > 0) Then bInsert = True: 'sTrigger = "M"
If vNPos < 0 And (vOPos > 0) Then bInsert = True: 'sTrigger = "N"

If bInsert Then
Cells(lRowIndex + 1, 1).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
'Debug.Print lRowIndex, sTrigger
End If

End If
Next

For lColIndex = 16 To 20
lLastColRow = Cells(Rows.Count, lColIndex).End(xlUp).Row
If lLastColRow > lLastRow Then lLastRow = lLastColRow
Next

For lRowIndex = lLastRow - 1 To 2 Step -1
If UCase(Cells(lRowIndex, 1).Value) = "BALANCE" Then
'On a BALANCE row
bInsert = False
vPPos = Cells(lRowIndex, "P").Value
vQPos = Cells(lRowIndex, "Q").Value
vRPos = Cells(lRowIndex, "R").Value
vSPos = Cells(lRowIndex, "S").Value
vTPos = Cells(lRowIndex, "T").Value

If vPPos < 0 And (vQPos > 0 Or vRPos > 0 Or vSPos > 0 Or vTPos > 0) Then bInsert = True: 'sTrigger = "P"
If vQPos < 0 And (vRPos > 0 Or vSPos > 0 Or vTPos > 0) Then bInsert = True: 'sTrigger = "Q"
If vRPos < 0 And (vSPos > 0 Or vTPos > 0) Then bInsert = True: 'sTrigger = "R"
If vSPos < 0 And (vTPos > 0) Then bInsert = True: 'sTrigger = "S"

If bInsert Then
Cells(lRowIndex + 1, 1).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
'Debug.Print lRowIndex, sTrigger
End If

End If
Next

End Sub

I am using the above code to find if there are any negetive value is followed by any positive value in the column FGHIJ,KLMNO,PQRST of Balance row. In column A there are multiple Balance rows.

The above code is working and it inserts a new row in above Balance when there are any negative value followed by any positive value from left to right. But for the column PQRST its not working, I dont know why & what should be the change required in the code for that ?

1. I want to add 2 rows if the condition meets instead of 1 rows in all 3 categorised columns (FGHIJ) (KLMNO) (PQRST)
2. I want to have a word "By Adjustment" in Column A in the first blank added row.
3. I want the portion should be filled in color green for which the condition met.

for example in F6 G6 H6 I6 J6
values are 0 -10 100 0 10

here 2 new row will be added
then F6 G6 H6 I6 J6 should be filled in with color green.

where ever the condition will be meet should be colored with green and two blank row should be inserted.
 

Forum statistics

Threads
1,081,535
Messages
5,359,365
Members
400,525
Latest member
swwber

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top