Copy/Paste only if a cell has a certain value

February 5, 2010 at 03:34:23
Specs: Windows XP
Hi guys,
Thanks for all the help again. Just a quick one. I include my code below which works okay - example: If the text in cell C says 'Post Office', the code copies the entire row to a sheet called Post Office - this works fine. However, I want the code to execute only if the value of the cell in row E of each entry says "Yes". Sounds simple! Thanks in advance

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 3 And UCase(Target) = UCase(ActiveCell.Text) Then
With Sheets(UCase(Target))
NxtRow = .Range("C" & Rows.Count).End(xlUp).Row + 1
Target.EntireRow.Copy
.Range("A" & NxtRow).PasteSpecial
Application.CutCopyMode = False
End With
End If
End Sub


See More: Copy/Paste only if a cell has a certain value

Report •

#1
February 5, 2010 at 04:31:45
Hi,

Your code tests that the changed cell 'Target' is in column 3, i.e.C

To test the value in column E, i.e., Column C + 2, use:
If Target.OFFSET(0, 2).Text="Yes"

Regards


Report •

#2
February 5, 2010 at 04:48:23
Humar, thanks for your reply, however, now the code still operates the same way, ie when column C has text in, only this time column E has to have yes, rather than the entire code waiting for a Yes to be selected in column E before executing, you know what I mean?

I attach code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 3 And UCase(Target) = UCase(ActiveCell.Text) And Target.Offset(0, 2).Text = "Yes" Then
With Sheets(UCase(Target))
NxtRow = .Range("C" & Rows.Count).End(xlUp).Row + 1
Target.EntireRow.Copy
.Range("A" & NxtRow).PasteSpecial
Application.CutCopyMode = False
End With
End If
End Sub

Thanks!


Report •

#3
February 5, 2010 at 06:12:28
Hi,

If you only want this code to run when a cell in column E is changed to "Yes", then make the change event test that the Target cell is in column E and it contains "Yes"

Then as before test that the cell in the same row, but column C contains text.

However you can no longer test it against the active cell, because the active cell is the one that contains "Yes", so you would have to hard code the address of the cell containing the text to be matched.

Perhaps go back and consider what you want as the trigger for the copy procedure - a cell having some text entered or a cell being changed to Yes. It can really only be one of these.

Regards


Report •

Related Solutions

#4
February 5, 2010 at 06:27:00
Humar,
Im very grateful for your help. I want the macro to trigger once I select Yes in the E Column, only then.
thanks

Report •

#5
February 5, 2010 at 06:48:30
Hi,

Try this framework

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim objISect As Object

On Error GoTo ErrHnd

'stop changes from re-triggering this code
Application.EnableEvents = False

'create an object if the Target is in column E
Set objISect = Application.Intersect(Target, Range("E:E"))

'test if the object was created (Target cell is in column E)
'and Target contains "Yes"
If Not objISect Is Nothing And UCase(Target.Text) = "YES" Then
    'Now test if text in Column C (Same row) contains the text in another cell
    'Change the cell address as required)
    If Target.Offset(0, -2).Text = Range("A1").Text Then
    
    '...
    'code to move the data in here
    '...

    End If
End If
'reenable events
Application.EnableEvents = True
Exit Sub

'error handler
ErrHnd:
Err.Clear
Application.EnableEvents = True
End Sub

Regards


Report •

#6
February 5, 2010 at 06:50:39
Have you tried this?

If Target.Column = 5 And UCase(Target) = "YES" Then
...
End If


Report •

#7
February 5, 2010 at 07:05:04
DerbyDad, thanks, tried that, still triggers code on wrong cell.

Humar, nothing working now. Think Its got to the stage where its staring me in the face and i cant see it.
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NxtRow As String
Dim objISect As Object

On Error GoTo ErrHnd

'stop changes from re-triggering this code
Application.EnableEvents = False

'create an object if the Target is in column E
Set objISect = Application.Intersect(Target, Range("E:E"))

'test if the object was created (Target cell is in column E)
'and Target contains "Yes"
If Not objISect Is Nothing And UCase(Target.Text) = "Yes" Then
'Now test if text in Column C (Same row) contains the text in another cell
'Change the cell address as required)
If Target.Offset(0, -2).Text = Range("A1").Text Then
NxtRow = Range("C" & Rows.Count).End(xlUp).Row + 1
Target.EntireRow.Copy
Range("A" & NxtRow).PasteSpecial
Application.CutCopyMode = False
End If
End If
'reenable events
Application.EnableEvents = True
Exit Sub

'error handler
ErrHnd:
Err.Clear
Application.EnableEvents = True
End Sub


Report •

#8
February 5, 2010 at 07:15:26
Derby, just checked that again, it cant find the correct sheet to go to and paste the row, because UCase(Target) is not a sheet name, whereas the sheets are names after the values of the C column

Report •

#9
February 5, 2010 at 07:17:23
re: DerbyDad, thanks, tried that, still triggers code on wrong cell.

Let's get it down to some basics:

What happens if you place this code, and only this code, in your sheet module?

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Column = 5 And UCase(Target) = "YES" Then
  MsgBox "Hi!"
 End If
End Sub

If you see "Hi!" at any time other than when those 2 conditions are met, then you have something else going on in the workbook.


Report •

#10
February 5, 2010 at 07:22:14
Hi,

Try putting a breakpoint near the start of the code.
In the bar to the left of the code, click alongside On error ...

A dot will appear in the bar and the line of code will be highlighted.

Now enter Yes in a cell in Column E.

This code should stop at the On Error ... line - highlighted in Yellow.

Use the f8 function key to step through the code, and see if it jumps to the error handler or just watch how it responds to lines of code especially at the if statements.

Also before running it, try Debug from the Menu and Compile VBA Project to ensure there are no obvious code errors.

Let us know what happens

Regards

PS you can see some of the values when the code is single stepped with f8 by hovering the mouse over some of the variables or addresses.


Report •

#11
February 5, 2010 at 09:17:25
Derby, I did get the Hi message with only that code.

Humar, it did highlight On Error straight away, i used f8 to go through the code, it all worked fine, but when i actually went and put YES into the column, nothing at all happened.

Im lost


Report •

#12
February 5, 2010 at 10:18:07
Hi,

If the On Error ... line was highlighted when you entered Yes in column E, and then continuing using f8 worked OK, then all is well.

You then say nothing happened when you entered Yes. Was the breakpoint still present in the code when you entered Yes again?

Regards


Report •

#13
February 5, 2010 at 10:29:57
Humar, I removed the dot and did it, still nothing - Im stumped. Heres exactly what I have

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NxtRow As String
Dim objISect As Object

On Error GoTo ErrHnd

'stop changes from re-triggering this code
Application.EnableEvents = False

'create an object if the Target is in column E
Set objISect = Application.Intersect(Target, Range("E:E"))

'test if the object was created (Target cell is in column E)
'and Target contains "Yes"
If Not objISect Is Nothing And UCase(Target.Text) = "Yes" Then
'Now test if text in Column C (Same row) contains the text in another cell
'Change the cell address as required)
If Target.Offset(0, -2).Text = Range("A1").Text Then
NxtRow = Range("C" & Rows.Count).End(xlUp).Row + 1
Target.EntireRow.Copy
Range("A" & NxtRow).PasteSpecial
Application.CutCopyMode = False
End If
End If
'reenable events
Application.EnableEvents = True
Exit Sub

'error handler
ErrHnd:
Err.Clear
Application.EnableEvents = True
End Sub


Report •

#14
February 5, 2010 at 14:05:40
Hi,

Change "Yes" to "YES".

If Not objISect Is Nothing And UCase(Target.Text) = "YES" Then

My fault - I added the UCase afterwards to allow variations of yes, Yes etc. but didn't change the text to match.

Regards

Regards


Report •

#15
February 8, 2010 at 01:02:21
Humar,
I really appreciate the help, but still no joy. Would it be possible for me to somehow send you the file, Ive tried everything!

Report •

#16
February 8, 2010 at 05:03:21
Hi,

Send me a private message with your e-mail address (don't post it), and I'll give you an e-mail address that you can send the spreadsheet to.

Regards


Report •

#17
February 11, 2010 at 09:59:31
Hi,

I looked at the spreadsheet you sent.

The revised code will move the selected line - the one where the cell in column E has just changed to Yes, to the next empty row on a worksheet named with the name shown in the cell in column C.

I was not sure what type of PasteSpecial you wanted, so I selected Values only, but this can be changed.

I hope that this is what you were trying to achieve.

The main changes I made were to correct the test for Yes to be effectively case insensitive, and remove the redundant comparison between the value in the cell in Column C and cell A1.

I added a test to ensure that there is text in the cell in column C, but there is no test that this text is a valid worksheet name.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim strNxtRow As String
Dim objISect As Object
Dim strDestSheet As String

On Error GoTo ErrHnd

'stop changes from re-triggering this code
Application.EnableEvents = False

'create an object if the Target is in column E
Set objISect = Application.Intersect(Target, Range("E:E"))

'test if the object was created (Target cell is in column E)
'and Target contains "Yes"
If Not objISect Is Nothing And UCase(Target.Text) = "YES" Then
    'Move the row to the next row on the appropriate sheet
    'based on names in column C - but check that column C is not empty
    strDestSheet = Target.Offset(0, -2).Text
    If strDestSheet <> "" Then
        'find next row on appropriate worksheet
        strNxtRow = CStr(Worksheets(strDestSheet).Range("A65534").End(xlUp).Row + 1)
        'copy existing row
        Target.EntireRow.Copy
        'Paste special to next available row on appropriate worksheet
        Worksheets(strDestSheet).Range("A" & strNxtRow).PasteSpecial _
            Paste:=xlPasteValues
    End If
End If
'reenable events
Application.EnableEvents = True
Exit Sub

'error handler
ErrHnd:
Err.Clear
Application.EnableEvents = True
End Sub

Regards


Report •

Ask Question