help to amend code to offer different outcome

Microsoft Office access 2007 (full produ...
July 20, 2010 at 02:40:10
Specs: Windows XP
Hi all,
Me again, as always any help very much appreciated. The code below works totally fine, if Yes is selected in row F, the code jumps into action which is fine. I now need to also define what the code will do if I select Pending or No in Row F. If Pending is selected, I want the code to do nothing at all, but if No is selected in Row F, I want the code to copy that row to a sheet called Cancelled, and delete the row from the Student Input sheet (where the details are entered and where the code is). Code below. I should mention when i talk about 'selecting No etc' I mean I have Yes No and Pending on a data validation list.
Thanks!

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("F:F"))

'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
Application.CutCopyMode = False
End If
End If
'reenable events
Application.EnableEvents = True
Exit Sub

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


See More: help to amend code to offer different outcome

Report •


#1
July 20, 2010 at 07:15:08
Hi,

As you have only two conditions to act on, just extend your IF Then ... End IF
to
IF Then ... IFELSE Then ... End If

Like this:

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
        Application.CutCopyMode = False
    End If
    ElseIf Not objISect Is Nothing And UCase(Target.Text) = "NO" Then
    'add code to move/delete row here
    
End If

You can still use Target.EntireRow.Copy
then use your new destination, finding the next empty row as before, but with a different worksheet.
then Target.EntireRow.Delete

Regards
PS When posting code put your data between <pre> and </pre> tags that you can insert using the 'Pre' icon above the reply box. Then use the Preview button and edit, as required. To preview again, check the 'Check To Show Confirmation Page Again' box and click 'Confirm and see post'
Using the tags ensures that code retains its indenting.


Report •
Related Solutions


Ask Question