Excel VBA Trigger

aqeelnokia99

aqeelnokia99

Board Regular
Joined
Dec 23, 2018
Messages
145
Office Version
  1. 2013
Platform
  1. Windows
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
 
Sort by date Sort by votes

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
RudRud said:
you can upload into dropbox/google drive anyway,

Cells(c.Row - 1, "B").Resize(5000, 2).Value = Cells(c.Row - 1, "B").End(xlUp).Resize(1, 2).Value

(first resize row you can change to 5000 if you wish to fill up 5000 rows)

Please elaborate more with expected result or share the file, otherwise its hard to execute it :(
Click to expand...
i mean Trigger of F column range is from F2:F5000 after F5001 Macro will not work
 
Upvote 0
aqeelnokia99 said:
i mean Trigger of F column range is from F2:F5000 after F5001 Macro will not work
Click to expand...

Hi @aqeelnokia99 can you try this, f5001 still working in my site.

VBA Code: 
Option Compare Text
Option Explicit
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
Dim k%, i%
Dim c As Range

Application.EnableEvents = False
k = Target.Count

For Each c In Target

    If c.Value = "[comp. 1]" Then

            For i = 1 To 2
            If Target.Count > 1 Or c.Offset(-1, 0).Value = "[comp. 1]" 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.]"
             Cells(c.Row - 1, "B").Resize(2, 4).Value = Cells(c.Row - 1, "B").End(xlUp).Resize(1, 4).Value
        Else
        Cells(c.Row - 1, "B").Resize(2, 4).Value = Cells(c.Row - 1, "B").End(xlUp).Resize(1, 4).Value
        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.]"
           Cells(c.Row - 1, "B").Resize(1, 4).Value = Cells(c.Row - 1, "B").End(xlUp).Resize(1, 4).Value
        Else
        Cells(c.Row - 2, "B").Resize(1, 4).Value = Cells(c.Row - 1, "B").End(xlUp).Resize(1, 4).Value
        End If


    ElseIf c.Value = "not done" Then

    End If
 
Next

End If

Application.EnableEvents = True

End Sub
 
Upvote 0
RudRud said:
Hi @aqeelnokia99 can you try this, f5001 still working in my site.

VBA Code: 
Option Compare Text
Option Explicit
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
Dim k%, i%
Dim c As Range

Application.EnableEvents = False
k = Target.Count

For Each c In Target

    If c.Value = "[comp. 1]" Then

            For i = 1 To 2
            If Target.Count > 1 Or c.Offset(-1, 0).Value = "[comp. 1]" 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.]"
             Cells(c.Row - 1, "B").Resize(2, 4).Value = Cells(c.Row - 1, "B").End(xlUp).Resize(1, 4).Value
        Else
        Cells(c.Row - 1, "B").Resize(2, 4).Value = Cells(c.Row - 1, "B").End(xlUp).Resize(1, 4).Value
        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.]"
           Cells(c.Row - 1, "B").Resize(1, 4).Value = Cells(c.Row - 1, "B").End(xlUp).Resize(1, 4).Value
        Else
        Cells(c.Row - 2, "B").Resize(1, 4).Value = Cells(c.Row - 1, "B").End(xlUp).Resize(1, 4).Value
        End If


    ElseIf c.Value = "not done" Then

    End If
 
Next

End If

Application.EnableEvents = True

End Sub
Click to expand...
Its Skip Value . only past 1 value instead of 2 Like if you check image VBA not Past Cardboard box
1688026615599.png
 
Upvote 0
1688026870957.png

here in my end, might be something wrong in your end though :cautious: . Did you use the code below?

VBA Code: 
Option Compare Text
Option Explicit
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
Dim k%, i%
Dim c As Range

Application.EnableEvents = False
k = Target.Count

For Each c In Target

    If c.Value = "[comp. 1]" Then

            For i = 1 To 2
            If Target.Count > 1 Or c.Offset(-1, 0).Value = "[comp. 1]" 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.]"
             Cells(c.Row - 1, "B").Resize(2, 4).Value = Cells(c.Row - 1, "B").End(xlUp).Resize(1, 4).Value
        Else
        Cells(c.Row - 1, "B").Resize(2, 4).Value = Cells(c.Row - 1, "B").End(xlUp).Resize(1, 4).Value
        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.]"
           Cells(c.Row - 1, "B").Resize(1, 4).Value = Cells(c.Row - 1, "B").End(xlUp).Resize(1, 4).Value
        Else
        Cells(c.Row - 2, "B").Resize(1, 4).Value = Cells(c.Row - 1, "B").End(xlUp).Resize(1, 4).Value
        End If


    ElseIf c.Value = "not done" Then

    End If
 
Next

End If

Application.EnableEvents = True

End Sub
 
Upvote 0
Thanks for Help i dont understand what is issue some time code work some time its not work
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question
Excel Userform Listbox Search issues
Replies
3
Views
160
Akuini
Akuini
S
  • Solved
Not copying first Column of table
Replies
2
Views
215
sean1541
S
A
  • Question
VBA Userform List Box to Populate upon entering a specific text in Column B, copy data upon selection and paste data in the same Row in another Column
Replies
3
Views
198
arijitirf
A
D
  • Question
Issue making macro or formula on my spreedsheet
Replies
2
Views
98
devan69
D
H
  • Solved
Using Macro/VLOOKUP to return format of cell
Replies
9
Views
161
mumps
mumps

Forum statistics

Threads
1,215,267
Messages
6,123,963
Members
449,137
Latest member
yeti1016

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top