VBA to copy paste entire row to existing sheet based on multiple cell criteria

S

Shatners Bassoon

New Member
Joined
Oct 19, 2018
Messages
3
Hi all,

new member with limited VBA knowledge I'm afraid. I have below code which works fine however I would like to
expand this to do the following: In column Q I have a drop down list with 3 options (say A, B and C) and if this cell is not populated, I want a message displayed to the user to please fill it in with A, B or C and the macro to stop (go back to status Open):


Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 7 And (Target.Text) = "Resolved" Then


Dim rngCell As Range
Dim rngDest As Range
Dim strRowAddr As String

'save target row address
strRowAddr = Target.Address

'find next row in destination worksheet
Set rngDest = Worksheets("Closed Issues"). _
Range("A" & CStr(Application.Rows.Count)).End(xlUp).Offset(1, 0)
Target.Offset(, -2) = Now()
'cut the source row & paste to destination
Target.EntireRow.Cut Destination:=rngDest
'remove the cut/copy range marquee
Application.CutCopyMode = False
'delete the source row
Worksheets("TEE Pending Issues").Range(strRowAddr).EntireRow.Delete _
Shift:=xlUp
End If

End Sub

Appreciate any help I can get as I have looked all morning but could not find the solution.
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
Sort by date Sort by votes
See if this works, add it under your code line: "
If Target.Column = 7 And (Target.Text) = "Resolved" Then

Code: 
      [TABLE="width: 591"]
<colgroup><col></colgroup><tbody>[TR]
[TD]                    If Range("Q" & ActiveCell.Row).Value= "" Then [/TD]
[/TR]
[TR]
[TD]                    MsgBox("Please select from dropdown list in Column Q")
                    End if
[/TD]
[/TR]
[TR]
[TD]                    Exit Sub[/TD]
[/TR]
[TR]
[TD]
[code/]


[/TD]
[/TR]
</tbody>[/TABLE]
<strike></strike>
[/FONT][/COLOR][/LEFT][/I]
​
 
Upvote 0
B4andafter said:
See if this works, add it under your code line: "
If Target.Column = 7 And (Target.Text) = "Resolved" Then

Code: 
      [TABLE="width: 591"]
<tbody>[TR]
[TD]                    If Range("Q" & ActiveCell.Row).Value= "" Then
[/TD]
[/TR]
[TR]
[TD]                    MsgBox("Please select from dropdown list in Column Q")
                    End if
[/TD]
[/TR]
[TR]
[TD]                    Exit Sub
[/TD]
[/TR]
[TR]
[TD][code/]


[/TD]
[/TR]
</tbody>[/TABLE]
<strike></strike>
[/FONT][/COLOR][/LEFT]
[/I][/QUOTE]
Thanks for your reply, however,  I wasn't very clear with my question. Column Q is a required field to be populated before the row is copied to the other workbook.
If this field is not populated, I would like column G to revert back to "Open" and "not stay on "Resolved" (only 2 options for this row). If both G and Q are populated then the macro can run.
​
Click to expand...
 
Upvote 0
I added a few lines to your original code and maybe this is what you are looking for.

Code: 
[COLOR=#333333]Option Explicit[/COLOR]
[COLOR=#333333]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR]
[TABLE="width: 509"]
<colgroup><col></colgroup><tbody>[TR]
[TD]Dim erow As Long[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]If Cells(erow, 7).Value = "Open" Then[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]    If Cells(erow, "Q").Value = "" Then[/TD]
[/TR]
[TR]
[TD]    MsgBox ("Please select from dropdown list in Column Q")[/TD]
[/TR]
[TR]
[TD]    Else[/TD]
[/TR]
[TR]
[TD]      GoTo Main[/TD]
[/TR]
[TR]
[TD]    End If[/TD]
[/TR]
[TR]
[TD]End If[/TD]
[/TR]
[TR]
[TD]Exit Sub[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="width: 354"]
<colgroup><col></colgroup><tbody>[TR]
[TD]Main:[/TD]
[/TR]
</tbody>[/TABLE]
[COLOR=#333333]If Target.Column = 7 And (Target.Text) = "Resolved" Then[/COLOR]


[COLOR=#333333]Dim rngCell As Range[/COLOR]
[COLOR=#333333]Dim rngDest As Range[/COLOR]
[COLOR=#333333]Dim strRowAddr As String[/COLOR]

[COLOR=#333333]'save target row address[/COLOR]
[COLOR=#333333]strRowAddr = Target.Address[/COLOR]

[COLOR=#333333]'find next row in destination worksheet[/COLOR]
[COLOR=#333333]Set rngDest = Worksheets("Closed Issues"). _[/COLOR]
[COLOR=#333333]Range("A" & CStr(Application.Rows.Count)).End(xlUp).Offset(1, 0)[/COLOR]
[COLOR=#333333]Target.Offset(, -2) = Now()[/COLOR]
[COLOR=#333333]'cut the source row & paste to destination[/COLOR]
[COLOR=#333333]Target.EntireRow.Cut Destination:=rngDest[/COLOR]
[COLOR=#333333]'remove the cut/copy range marquee[/COLOR]
[COLOR=#333333]Application.CutCopyMode = False[/COLOR]
[COLOR=#333333]'delete the source row[/COLOR]
[COLOR=#333333]Worksheets("TEE Pending Issues").Range(strRowAddr).EntireRow.Delete _[/COLOR]
[COLOR=#333333]Shift:=xlUp[/COLOR]
[COLOR=#333333]End If[/COLOR]

[COLOR=#333333]End Sub[/COLOR]

Let me know... thanks.
 
Upvote 0
B4andafter said:
I added a few lines to your original code and maybe this is what you are looking for.

Code: 
[COLOR=#333333]Option Explicit[/COLOR]
[COLOR=#333333]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR]
[TABLE="width: 509"]
<tbody>[TR]
[TD]Dim erow As Long
[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]If Cells(erow, 7).Value = "Open" Then
[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]    If Cells(erow, "Q").Value = "" Then
[/TD]
[/TR]
[TR]
[TD]    MsgBox ("Please select from dropdown list in Column Q")
[/TD]
[/TR]
[TR]
[TD]    Else
[/TD]
[/TR]
[TR]
[TD]      GoTo Main
[/TD]
[/TR]
[TR]
[TD]    End If
[/TD]
[/TR]
[TR]
[TD]End If
[/TD]
[/TR]
[TR]
[TD]Exit Sub
[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="width: 354"]
<tbody>[TR]
[TD]Main:
[/TD]
[/TR]
</tbody>[/TABLE]
[COLOR=#333333]If Target.Column = 7 And (Target.Text) = "Resolved" Then[/COLOR]


[COLOR=#333333]Dim rngCell As Range[/COLOR]
[COLOR=#333333]Dim rngDest As Range[/COLOR]
[COLOR=#333333]Dim strRowAddr As String[/COLOR]

[COLOR=#333333]'save target row address[/COLOR]
[COLOR=#333333]strRowAddr = Target.Address[/COLOR]

[COLOR=#333333]'find next row in destination worksheet[/COLOR]
[COLOR=#333333]Set rngDest = Worksheets("Closed Issues"). _[/COLOR]
[COLOR=#333333]Range("A" & CStr(Application.Rows.Count)).End(xlUp).Offset(1, 0)[/COLOR]
[COLOR=#333333]Target.Offset(, -2) = Now()[/COLOR]
[COLOR=#333333]'cut the source row & paste to destination[/COLOR]
[COLOR=#333333]Target.EntireRow.Cut Destination:=rngDest[/COLOR]
[COLOR=#333333]'remove the cut/copy range marquee[/COLOR]
[COLOR=#333333]Application.CutCopyMode = False[/COLOR]
[COLOR=#333333]'delete the source row[/COLOR]
[COLOR=#333333]Worksheets("TEE Pending Issues").Range(strRowAddr).EntireRow.Delete _[/COLOR]
[COLOR=#333333]Shift:=xlUp[/COLOR]
[COLOR=#333333]End If[/COLOR]

[COLOR=#333333]End Sub[/COLOR]

Let me know... thanks.
Click to expand...

Thanks for your assistance, however above code does not seem to work for what I need.
Default in column 7 is ‘Open’, when this is changed to ‘Resolved’it will be copy pasted to a another worksheet.
I have 3 dropdown options in column Q (A, B and C), if thisis left blank and the user tries to change cell 7 to resolved, the message boxpops up to change cell Q to A,B or C.
I would then like the cell 7 that was changed to ‘Resolved’ togo back to status ‘Open’ without the user having to change this.
 
Upvote 0
Shatners Bassoon said:
Default in column 7 is ‘Open’, when this is changed to ‘Resolved’it will be copy pasted to a another worksheet.
I have 3 dropdown options in column Q (A, B and C), if thisis left blank and the user tries to change cell 7 to resolved, the message boxpops up to change cell Q to A,B or C.
I would then like the cell 7 that was changed to ‘Resolved’ togo back to status ‘Open’ without the user having to change this.
Click to expand...

Hi,
not sure if you have resolved this issue yet but if not, see if this update to your code does what you want

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngDest As Range
    
    On Error GoTo exitsub
    Application.EnableEvents = False
    If Target.Column = 7 Then
        If Len(Target.Offset(, 10).Value) = 0 Then
            Target.Value = "Open"
            
            MsgBox "Please Select Option A, B or C", 16, "Selection Required"
            
        ElseIf Target.Value = "Resolved" Then
            
'find next row in destination worksheet
            Set rngDest = Worksheets("Closed Issues"). _
            Range("A" & CStr(Application.Rows.Count)).End(xlUp).Offset(1, 0)
            Target.Offset(, -2) = Now()
'cut the source row & paste to destination
            With Target.EntireRow
                .Copy Destination:=rngDest
'delete the source row
                .Delete Shift:=xlUp
            End With
        End If
    End If
    
exitsub:
    With Application
        .CutCopyMode = False: .EnableEvents = True
    End With
    
End Sub

Update untested & should be adjusted as required

Dave
 
Upvote 0
In that case, you can do this piece without additional VBA coding to your original subroutine. I would add an if formula and lock column 7 (G).

Lets say you start from the top and the following formula to cell G2: =IF(Q2<>"","Resolved","Open") and copy down to however many roads you would ever need.

Then lock the column G to avoid anyone else changing this Column. To do this I refer you to the following link:

https://support.office.com/en-us/ar...orksheet-75481b72-db8a-4267-8c43-042a5f2cd93a


In my opinion, this is the best way to handle your process without complex coding. Try this let me know.
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
Copy row based on cell value and paste as text in another worksheet
Replies
2
Views
479
DH937
D
B
  • Question
VBA code to cut and paste multiple filtered rows based on multiple criteria
Replies
2
Views
495
Alex Blakenburg
A
U
  • Solved
Copy/Paste Rows on select criteria
Replies
4
Views
826
UTB
U
tabbytomo
  • Solved
Copy entire row if cell has specific value, looking at multiple columns and worksheets.
Replies
2
Views
290
NateSC
NateSC
C
  • Solved
VBA - Copy Files with Prefix to Multiple Destinations Based on Cell Value
Replies
3
Views
244
ChaseHammer
C

Forum statistics

Threads
1,214,974
Messages
6,122,536
Members
449,088
Latest member
RandomExceller01

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