VBA to Copy and Paste values to same row range in same sheet based on a Trigger

[RaginMuse]

I'm fairly new to VBA and I'm hoping I could get some help here to achieve what I'm trying to do. I've searched and read through, and a lot of solutions are about copying and pasting from one sheet to another.
Basically, I want to Copy and Paste the Values in the same row range based on a trigger from another column in the same Sheet.

I've Column G with the trigger word, which is "Hired"; I've data range J5:AG436 For example, if G11 is "Hired", I want the existing data in J11:AG11 to be copied and pasted as Values.

Here's a code that I'm trying to use but got nowhere with it. Perhaps this is not it?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim triggerColumn As Long
triggerColumn = 7 ' column G is the trigger column
Dim triggerWord As String
triggerWord = "Hired" ' the trigger word to look for
   
'define range to which the code will be applied
Dim dataRange As Range
Set dataRange = Me.Range("J11:AG436") 'change to match the range of your data
   
If Not Intersect(Target, dataRange) Is Nothing Then
' a cell within the data range was changed
If Target.Column = triggerColumn Then
' the trigger column was changed
If InStr(1, Target.Value, triggerWord, vbTextCompare) > 0 Then
' the trigger word was found in the changed cell
' copy and paste special values from the current cell
                Target.Copy
                Target.PasteSpecial xlPasteValues
End If
End If
End If
End Sub

Any help is greatly appreciated.

 

[vcoolio]

Hello RaginMuse,

I'm not sure where you want to paste to, so I've assumed Sheet2, Column A is the destination:-

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Columns(7)) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target.Value = vbNullString Then Exit Sub
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
          trow = Target.Row
          If Target.Value = "Hired" Then
                Range(Cells(trow, "J"), Cells(trow, "AG")).Copy
                Sheet2.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
          End If
    
    Application.EnableEvents = True
    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub

I hope that this helps.

Cheerio,
vcoolio.

 

[bebo021999]

Try:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("G11:G436")) Is Nothing Or Target.Value <> "Hired" Or Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
With Range(Cells(Target.Row, "J"), Cells(Target.Row, "AG"))
    .Value = .Value
End With
Application.EnableEvents = True
End Sub

 

[vcoolio]

Hello RaginMuse,

The code amended as follows with a message box pop-up might suffice. You can change the actual message to suit your needs if you like.

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim Warning As String
    
    If Intersect(Target, Columns(7)) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target.Value = vbNullString Then Exit Sub
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Warning = MsgBox("Be warned that the action you are about to take is irreversible. To continue, click OK.", vbCritical + vbOKCancel, "WARNING")
          If Warning = vbOK Then
                trow = Target.Row
                If Target.Value = "Hired" Then
                     With Me.Range(Cells(trow, "J"), Cells(trow, "AG"))
                            .Value = .Value
                     End With
                     Else: Exit Sub
                End If
          End If
          
    Application.EnableEvents = True
    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub

I hope that this helps.

Cheerio,
vcoolio.

 

[vcoolio]

You're welcome RM. I'm glad to have been able to assist and thanks for the feed back.

Cheerio,
vcoolio.

 

[RaginMuse]

Thank you for your assistance, Vcoolio.
I want to copy and paste in the same row, not a different sheet.

 

[RaginMuse]

Try:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("G11:G436")) Is Nothing Or Target.Value <> "Hired" Or Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
With Range(Cells(Target.Row, "J"), Cells(Target.Row, "AG"))
    .Value = .Value
End With
Application.EnableEvents = True
End Sub

It's not working for me.
The solution from Vcoolio is working, except I want the copied range to be pasted in the exact same range but as Values.
Thanks for your help

 

[RaginMuse]

VBA Test Sheet.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG
7	No.	Division	Department	Designation	Level	Number	Status	Month to onboard	Month	Jan-23	Feb-23	Mar-23	Apr-23	May-23	Jun-23	Jul-23	Aug-23	Sep-23	Oct-23	Nov-23	Dec-23	Jan-24	Feb-24	Mar-24	Apr-24	May-24	Jun-24	Jul-24	Aug-24	Sep-24	Oct-24	Nov-24	Dec-24
8	1	Food & Beverage	F&B Culinary	Commis I	L5	Xx		2	Aug-23	-	-	-	-	-	-	-	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1
9	2	Food & Beverage	F&B Culinary	Commis I	L5	Xx		2	Aug-23	-	-	-	-	-	-	-	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1
10	3	Food & Beverage	F&B Culinary	Commis I	L5	Xx		2	Aug-23	-	-	-	-	-	-	-	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1
Rampup 23 & 24

Cell Formulas
Range	Formula
J7	J7	=F1
K7:AG7	K7	=EDATE(J7,1)
J8:AG10	J8	=IF(AND(J$6<=$H8,$H8<>0),1,0)

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
H8:AG24,BF8:PY24,QA8:QM24,QO8:RA24	Cell Value	=0	text	NO

 

[RaginMuse]

VBA Test Sheet.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG
7	No.	Division	Department	Designation	Level	Number	Status	Month to onboard	Month	Jan-23	Feb-23	Mar-23	Apr-23	May-23	Jun-23	Jul-23	Aug-23	Sep-23	Oct-23	Nov-23	Dec-23	Jan-24	Feb-24	Mar-24	Apr-24	May-24	Jun-24	Jul-24	Aug-24	Sep-24	Oct-24	Nov-24	Dec-24
8	1	Food & Beverage	F&B Culinary	Commis I	L5	Xx		2	Aug-23	-	-	-	-	-	-	-	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1
9	2	Food & Beverage	F&B Culinary	Commis I	L5	Xx		2	Aug-23	-	-	-	-	-	-	-	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1
10	3	Food & Beverage	F&B Culinary	Commis I	L5	Xx		2	Aug-23	-	-	-	-	-	-	-	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1	1
Rampup 23 & 24

Cell Formulas
Range	Formula
J7	J7	=F1
K7:AG7	K7	=EDATE(J7,1)
J8:AG10	J8	=IF(AND(J$6<=$H8,$H8<>0),1,0)

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
H8:AG24,BF8:PY24,QA8:QM24,QO8:RA24	Cell Value	=0	text	NO

Column G is where the trigger is.

 

[vcoolio]

Hello RaginMuse,

I'm not sure why Bebo's code doesn't work for you. However, try the following version:-

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Columns(7)) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target.Value = vbNullString Then Exit Sub
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
          trow = Target.Row
          If Target.Value = "Hired" Then
               With Me.Range(Cells(trow, "J"), Cells(trow, "AG"))
                      .Value = .Value
               End With
          End If
    
    Application.EnableEvents = True
    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub

I hope that this helps.

Cheerio,
vcoolio.