VBA Code not working

[SantanaKRE8s]

I Have a VBA code set up in one of my sheets and it works to remove complete rows and paste them on a diferent sheet. I wanted to automated so that it would do this when I select Resolved from a drop down list, but that VBA to automate this action is not working. one of my columsn just flashes when I select Resoved from the frop down list.

Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim Z As Long
Dim xVal As String
On Error Resume Next
If Intersect(Target, Range("S:S")) Is Nothing Then
Application.EnableEvents = False
For Z = 1 To Target.Count
If Target(Z).Value > 0 Then
Call MoveBasedOnValue
End If
Next
End If
Application.EnableEvents = True
End Sub

 

[Joe4]

Welcome to the Board!

If the values you are selecting are in column S, then you need to change this line:

If Intersect(Target, Range("S:S")) Is Nothing

to this:

If Not Intersect(Target, Range("S:S")) Is Nothing

 

[SantanaKRE8s]

Welcome to the Board!

If the values you are selecting are in column S, then you need to change this line:

If Intersect(Target, Range("S:S")) Is Nothing

to this:

If Not Intersect(Target, Range("S:S")) Is Nothing

Thank you very much Joe4, as soon as I made the change selected from drop down list it worked.

 

[Joe4]

You are welcome!

 

[SantanaKRE8s]

Sorry Im back, but my code just stopped working again and just the same column flashes, Everything seems the same.

Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim Z As Long
Dim xVal As String
On Error Resume Next
If Not Intersect(Target, Range("S:S")) Is Nothing Then
Application.EnableEvents = False
For Z = 1 To Target.Count
If Target(Z).Value > 0 Then
Call MoveBasedOnValue
End If
Next
End If
Application.EnableEvents = True
End Sub

 

[Joe4]

In order to help you further, I need 3 things from you.
1. A small example of what your data looks like
2. The VBA code behind your "MoveBasedOnValue" procedure
3. The exact entry you are making to trigger this code (what value are you entering into what cell?)

 

[SantanaKRE8s]

Sub MoveBasedOnValue()
'
Dim xRg As Range
Dim xCEll As Range
Dim A As Long
Dim B As Long
Dim C As Long
A = Worksheets("BACKLOG").UsedRange.Rows.Count
B = Worksheets("RESOLVED").UsedRange.Rows.Count
If B = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("RESOLVED").UsedRange) = 0 Then B = 0
End If
Set xRg = Worksheets("BACKLOG").Range("S3:S" & A)
On Error Resume Next
Application.ScreenUpdating = False
For C = 1 To xRg.Count
If CStr(xRg(C).Value) = "Resolved" Then
xRg(C).EntireRow.Copy Destination:=Worksheets("RESOLVED").Range("A" & B + 1)
xRg(C).EntireRow.Delete
If CStr(xRg(C).Value) = "Resolved" Then
C = C - 1
End If
B = B + 1
End If
Next
Application.ScreenUpdating = True
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim Z As Long
Dim xVal As String
On Error Resume Next
If Not Intersect(Target, Range("S:S")) Is Nothing Then
Application.EnableEvents = False
For Z = 1 To Target.Count
If Target(Z).Value > 0 Then
Call MoveBasedOnValue
End If
Next
End If
Application.EnableEvents = True
End Sub

 

[Joe4]

OK, tell me if this correctly summarizes what you are trying to do.
If you manually select the "Resolved" option from the drop-down in column S on the "Backlog" sheet, it should move that entire row to the bottom of the "Resolved" sheet.
Is that correct?
And you are only updating column S one row at a time, right?

If those assumptions are correct, I believe we can simplify your code greatly.

 

[Joe4]

If my assumptions are correct, I think that you only need this "Worksheet_Change" procedure, and nothing else:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range
    
'   See if any updates to column S
    Set rng = Intersect(Range("S:S"), Target)
    
'   Exit if no updates to column S
    If rng Is Nothing Then Exit Sub
    
'   Loop through values updated in column S
    Application.EnableEvents = False
    For Each cell In rng
'       See if cell value is Resovled
        If cell.Value = "Resolved" Then
'           Copy to bottom of resolved sheet
            Rows(cell.Row).Copy Sheets("Resolved").Range("A" & Sheets("Resolved").UsedRange.Rows.Count + 1)
'           Remove from backlog sheet
            Rows(cell.Row).Delete
        End If
    Next cell
    Application.EnableEvents = True
    
End Sub

 

[SantanaKRE8s]

Yes Joe, you nailed it, just want to mention that the row it cuts from Backlog and sends to resolved sheet goes straight to the next blank space. Also I would like to past only value and not the format so that I don not loose the format in REsolved page, By the way thanks for the help.