Change Event Code

[Skybluekid]

Hi All,

I am very stumped at the moment. I am using the below code to copy cells if the Sales person selects an option:

Private Sub Worksheet_Change(ByVal Target As Range)


            Dim R As Range
            Dim s As String
            Dim Rng(1 To 8)
            Dim NV As String
            Dim OV As String
            Dim FV As String
            Dim Rng2 As Range
            Dim Cell As Range
            Dim Old
            


'Execute code if value in twentieth column is changed
If Target.Column = 20 Then


        'If value in T column of the row is "Won" then copy the row to destination sheet
            If Target.Value = "Won" Then


            Rng(1) = "A" & Target.Row
            Rng(2) = "B" & Target.Row
            Rng(3) = "C" & Target.Row
            Rng(4) = "E" & Target.Row
            Rng(5) = "G" & Target.Row
            Rng(6) = "K" & Target.Row
            Rng(7) = "L" & Target.Row
            Rng(8) = "M" & Target.Row


            s = Join(Rng, ",")


            Set R = Range(s)


            R.Copy Destination:=Sheets("Won Business").Range("A" & Rows.Count).End(xlUp).Offset(1)
        
            End If
            
            'If value in T column of the row is "Lost" then copy the row to destination sheet
            If Target.Value = "Lost" Then


            Rng(1) = "A" & Target.Row
            Rng(2) = "B" & Target.Row
            Rng(3) = "C" & Target.Row
            Rng(4) = "E" & Target.Row
            Rng(5) = "G" & Target.Row
            Rng(6) = "K" & Target.Row
            Rng(7) = "L" & Target.Row
            Rng(8) = "M" & Target.Row


            s = Join(Rng, ",")


            Set R = Range(s)


            R.Copy Destination:=Sheets("Lost Business").Range("A" & Rows.Count).End(xlUp).Offset(1)
            
            End If
                 
            'If value in T column of the row is "Hot" then copy the row to destination sheet
            If Target.Value = "Hot" Then
                 
            Rng(1) = "A" & Target.Row
            Rng(2) = "B" & Target.Row
            Rng(3) = "C" & Target.Row
            Rng(4) = "E" & Target.Row
            Rng(5) = "G" & Target.Row
            Rng(6) = "K" & Target.Row
            Rng(7) = "L" & Target.Row
            Rng(8) = "M" & Target.Row


            s = Join(Rng, ",")


            Set R = Range(s)


            R.Copy Destination:=Sheets("Hot Deals").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    
            End If
End If


End Sub

This works well, but I have a twist. If the Sales has chosen Hot originally, then changes the value to Won (or Lost), I will need it find the deal on the Hot Deals Sheet, delete that row. It should also then copy the cells to the Won (or Lost, as the case maybe) Sheet.

I have looked at various options but none seem to work.

Thank you in Advance as any help would be very appreciated.

 

[Yongle]

1.below is your code amended to avoid duplicating many lines (ignore if you wish)

Private Sub Worksheet_Change(ByVal Target As Range)

Dim r As Range, s As String, Rng(1 To 8)
Dim sName As Worksheet, x As Long

'Execute code if value in twentieth column is changed
If Target.Column = 20 Then
        x = Target.Row
        Rng(1) = "A" & x
        Rng(2) = "B" & x
        Rng(3) = "C" & x
        Rng(4) = "E" & x
        Rng(5) = "G" & x
        Rng(6) = "K" & x
        Rng(7) = "L" & x
        Rng(8) = "M" & x
        s = Join(Rng, ",")
        Set r = Range(s)
'sheet name is based on target value
    Select Case LCase(Target.Value)
        Case "won":     Set sName = Sheets("Won Business")
        Case "lost":    Set sName = Sheets("Lost Business")
        Case "hot":     Set sName = Sheets("Hot Deals")
    End Select
'copy and paste
         r.Copy Destination:=sName.Range("A" & Rows.Count).End(xlUp).Offset(1)
End If

End Sub

2. Your Question...
Sheet X (=the sheet containing the value to be removed) can be determined when the user selects cell in column 20
Sheet Y (=the new sheet) can be determined when the user amends the value

But VBA needs to know which row on SheetX to delete
a) Are any of the 8 values copied across totally unique ? If so which one (A,B,C,E,G,K,L or M) ?
b) Otherwise the 8 values could be concatented and the row which returns the first match deleted
Obviously (a) and (b) are viable solutions only if users are not in the habit of amending values AFTER the values have been copied across

Let me know what might work
thanks

 

[Skybluekid]

Thank you for the code.

In the copied cells there is a Reference, for example, DW1123, this is unique to that row.

I have tried the below, but it does not work

For Each Cell In Target


    If Not (Intersect(Cell, Target.Column) Is Nothing) Then
        NV = Cell.Value
        OV = Old
        
            If OV = "Hot" And NV = "Won" Then
            
                FV = Range("E" & Target.Row).Value
            
                Set Rng2 = Sheets("Hot Deals").Range("D" & Rows.Count).End(xlUp).Find(FV)
                
                If Rng2 = "" Then
            
                    MsgBox "No Value was found on Hot Deals Sheet"
                
                    Else
                
                    Sheets("Hot Deals").Rng2.Rows.Delete
                
                End If
                
            End If


    End If
    
Next Cell



Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Old = Target.Value
End Sub

 

[Yongle]

In the copied cells there is a Reference, for example, DW1123, this is unique to that row

- in which column is that reference in the original sheet?
- in which column is that reference in the (Won/Lost Hot) sheet?

 

[Skybluekid]

Original Sheet Column E
Hot Deal Sheet D

 

[Yongle]

Try something like this (goes in sheet module)
- triggers when user selects cell in column 20 where cell already contains a value

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim uniq As String, sName As Worksheet, foundCell As Range
If Target.CountLarge > 1 Then Exit Sub

If Target.Column = 20 Then
        If Target = "" Then Exit Sub
        If Not MsgBox("Do you want to change selected value", vbYesNo) = vbYes Then
            Target.Offset(, 1).Select
        Else
          [COLOR=#006400][I]  'what is VBA looking for (column E value)[/I][/COLOR]
            uniq = Range("E" & Target.Row)
[I][COLOR=#006400]            'which sheet?[/COLOR][/I]
            Select Case LCase(Target.Value)
                Case "won":     Set sName = Sheets("Won Business")
                Case "lost":    Set sName = Sheets("Lost Business")
                Case "hot":     Set sName = Sheets("Hot Deals")
            End Select
       [I][COLOR=#006400] 'find the value in column D of the other sheet[/COLOR][/I]
            On Error Resume Next    'require this in case it is not in the sheet
            Set foundCell = sName.Range("D:D").Find(What:=uniq, LookIn:=xlValues, LookAt:=xlWhole)
            If Not foundCell Is Nothing Then
       [I][COLOR=#006400] 'delete the row[/COLOR][/I]
                foundCell.EntireRow.Delete
                Application.EnableEvents = [COLOR=#ff0000]False [/COLOR]   [COLOR=#006400]'prevents Worksheet_Change from being trigerred temporarily[/COLOR]
                    Target.ClearContents
                Application.EnableEvents = [COLOR=#ff0000]True[/COLOR]
            Else
                MsgBox "Reference " & uniq & " not found in " & sName.Name
            End If
            On Error GoTo 0
        End If
End If
End Sub

You also need this lne in Worksheet_Change in case anyone deletes the value - prevents code from failing
(or use Data Validation to prevent value being deleted and force one of the valid options to be selected)

If Target.Column = 20 Then
[COLOR=#ff0000]    If Target.Value = "" Then Exit Sub[/COLOR]

 

[Skybluekid]

Thank you very much. This has help my understanding as well