Excel VBA Trigger

[aqeelnokia99]

Dear Expert ,
i want 1 VBA if i write word "done" in any row in column f it need to check 2 Row above in column G we have 2 rows with name "Box" and "Bag" in G if any of these not found add 1 or 2 row according to missing Text above in case not found with Value G=Box or Bag H = "Card" For example i write done in F11 its need to check 2 row back Like G10 and G9 we have any missing value Like "Box" Or "Bag" in case Box not found add 1 row with Box in G10 and H10 value will Be "Card" also auto fill value of column B 1 row above value Like for example if we add 1 row G10 fill value of B10 =B9 if we add 2 rows like "Box" Or "Bag" both not found so value in B9 and B10 both will be B8

 

[RudRud]

F11 = Done

Check If G9 - G10 got "Bag" Or box (If both not found)
then add one row above F11 (meaning: F12 Done, G10 = Box, H10 = Card)
B9 = B8
B10 = b8

If g10 got bag/box how's the condition?

If g10 found nothing and g9 got bag/box how's the condition?

 

[aqeelnokia99]

i want to modify This VBA with 2 Condition

 

[aqeelnokia99]

if i write word "done" in any row in column f it need to check 2 Row above in column G Like if i write Done in F10 VBA need to check G9 and G8 if G9 and G8 both Cell Value must Be Equal to Box or Bag if we dont found any of these Value Insert 1 or 2 Row if we have Box but not have Bag then 1 row if we have Bag not Box then 1 if both not found Then add 2 rows above After we add new row above then New Row Value must be Bag/Box which was not found and In case if its Box was added then column G value ="BCard" if its Bag was added then column G value ="BagC"

 

[RudRud]

Kindly give a shot @aqeelnokia99

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim boxbag$, boxbag2$
If Not Intersect(Target, Columns(6)) Is Nothing Then
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
dict.Comparemode = vbTextCompare

Application.EnableEvents = False

    For Each c In Target
        If c.Value = "done" Then
            Cells(c.Row, "g").Value = "Sent"
            Cells(c.Row, "h").Value = "Approve"
            Cells(c.Row, "i").Value = Cells(c.Row, "o") / Cells(c.Row, "p")
            
            For i = 1 To 2
                If Len(Cells(c.Row - i, "g").Value) > 3 Then
                Exit For
                Else
                dict.Add Cells(c.Row - i, "g").Value, i
                End If
            Next i
            
            If Not dict.exists("box") Then
                c.EntireRow.Insert
                 Cells(c.Row - 1, "g").Value = "Box"
                Cells(c.Row - 1, "h").Value = "Bcard"
            End If
            
              If Not dict.exists("bag") Then
                c.EntireRow.Insert
                 Cells(c.Row - 1, "g").Value = "Bag"
                Cells(c.Row - 1, "h").Value = "Bagc"
            End If

            
        ElseIf c.Value = "not done" Then
            Cells(c.Row, "f").Value = "not sent"
            Cells(c.Row, "g").Value = "not approve"
            Cells(c.Row, "h").Value = "not approve"
            Cells(c.Row, "i").Value = ""
        End If
    Next
        
End If

Application.EnableEvents = True

End Sub

 

[aqeelnokia99]

Thanks you so much for Great Help i pray for you may get Biggest wealth in your Life . i am checking now

 

[aqeelnokia99]

I modify VBA according to my Requirement all working good but only 1 issue in case if we already have Cardboard box and PE bag its still add new Line
Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim boxbag$, boxbag2$
If Not Intersect(Target, Columns(6)) Is Nothing Then
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
dict.Comparemode = vbTextCompare

Application.EnableEvents = False

For Each c In Target
If c.Value = "done" Then


For i = 1 To 2
If Len(Cells(c.Row - i, "g").Value) > 3 Then
Exit For
Else
dict.Add Cells(c.Row - i, "g").Value, i
End If
Next i

If Not dict.exists("Cardboard box") Then
c.EntireRow.Insert
Cells(c.Row - 1, "g").Value = "Cardboard box"
Cells(c.Row - 1, "I").Value = "Cardboard"
Cells(c.Row - 1, "J").Value = "Cardboard and paper"
Cells(c.Row - 1, "K").Value = "packaging"
Cells(c.Row - 1, "M").Value = "Kina"
Cells(c.Row - 1, "N").Value = 1500
Cells(c.Row - 1, "O").Value = 1
Cells(c.Row - 1, "F").Value = "[comp.]"
End If

If Not dict.exists("PE bag") Then
c.EntireRow.Insert
Cells(c.Row - 1, "g").Value = "PE bag"
Cells(c.Row - 1, "I").Value = "HDPE"
Cells(c.Row - 1, "J").Value = "plastic"
Cells(c.Row - 1, "K").Value = "packaging"
Cells(c.Row - 1, "M").Value = "Kina"
Cells(c.Row - 1, "N").Value = 100
Cells(c.Row - 1, "O").Value = 1
Cells(c.Row - 1, "F").Value = "[comp.]"
End If


ElseIf c.Value = "not done" Then

End If
Next

End If

Application.EnableEvents = True

End Sub

 

[aqeelnokia99]

Kindly check the Issue Thanks

 

[RudRud]

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Columns(6)) Is Nothing Then
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
dict.Comparemode = vbTextCompare

Application.EnableEvents = False

For Each c In Target
If c.Value = "done" Then


For i = 1 To 2
'If Not Len(Cells(c.Row - i, "g").Value) > 3 Then
'do nothing
'Else
dict.Add Cells(c.Row - i, "g").Value, i
'End If
Next i

If Not dict.exists("Cardboard box") Then
c.EntireRow.Insert
Cells(c.Row - 1, "g").Value = "Cardboard box"
Cells(c.Row - 1, "I").Value = "Cardboard"
Cells(c.Row - 1, "J").Value = "Cardboard and paper"
Cells(c.Row - 1, "K").Value = "packaging"
Cells(c.Row - 1, "M").Value = "Kina"
Cells(c.Row - 1, "N").Value = 1500
Cells(c.Row - 1, "O").Value = 1
Cells(c.Row - 1, "F").Value = "[comp.]"
End If

If Not dict.exists("PE bag") Then
c.EntireRow.Insert
Cells(c.Row - 1, "g").Value = "PE bag"
Cells(c.Row - 1, "I").Value = "HDPE"
Cells(c.Row - 1, "J").Value = "plastic"
Cells(c.Row - 1, "K").Value = "packaging"
Cells(c.Row - 1, "M").Value = "Kina"
Cells(c.Row - 1, "N").Value = 100
Cells(c.Row - 1, "O").Value = 1
Cells(c.Row - 1, "F").Value = "[comp.]"
End If


ElseIf c.Value = "not done" Then

End If
Next

End If

Application.EnableEvents = True

End Sub

please try this, i will re-check for it for other conditions that not yet stated @aqeelnokia99

 

[aqeelnokia99]

Thanks its working 1 last Condition need auto fill value from above in column B and C in case if we added now Line if Like for Example if Cardboard box was not found in 2 row above we add it now new added row must take data from his 1 row above Like if we add row row 10 B10 Value =B9 C10 Value =C9