Is it possible to insert a slicer before the vba code runs?

[Juan Jacobs]

I have created a vba code which copies data from the main sheet to a new sheet depending on a specific cell "Status". If Status is set to active then that particular row is copied and pasted to a new sheet called active. If the status is changed to inactive then that specific row copies and pastes to a new worksheet called inactive.

I have not yet found a way to remove the row from the copied sheet if the status is changed to something else on the main sheet.

My main issue is that I would like to insert a slicer which allows the user to choose the province of the member first.

Once the province is selected, I then need the row to be copied to the new worksheet once the user changes the members status.

The code is below:

>>> use code - tags <<<

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


Dim lngLastRow As Long
Dim ActiveSheet As Worksheet, InactiveSheet As Worksheet, PendingSheet As Worksheet, RenewedSheet As Worksheet, FollowUpSheet As Worksheet, RedZoneSheet As Worksheet

Set ActiveSheet = Sheets("Active")
Set InactiveSheet = Sheets("Inactive")
Set PendingSheet = Sheets("Pending")
Set RenewedSheet = Sheets("Renewed")
Set FollowUpSheet = Sheets("Follow Up")
Set RedZoneSheet = Sheets("Red Zone")

lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row


With Range("A5", "R" & lngLastRow)
.AutoFilter
.AutoFilter Field:=4, Criteria1:="Active"
.Copy ActiveSheet.Range("A1")
.AutoFilter Field:=4, Criteria1:="Inactive"
.Copy InactiveSheet.Range("A1")
.AutoFilter Field:=4, Criteria1:="Pending"
.Copy PendingSheet.Range("A1")
.AutoFilter Field:=4, Criteria1:="Renewed"
.Copy RenewedSheet.Range("A1")
.AutoFilter Field:=4, Criteria1:="Follow Up"
.Copy FollowUpSheet.Range("A1")
.AutoFilter Field:=4, Criteria1:="Red Zone"
.Copy RedZoneSheet.Range("A1")
.AutoFilter
End With


Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub

 

[BobBridges]

Most of your explanation makes sense, but I need to know what you mean by both "province" and "member" in the third paragraph.

But in the first paragraph you say you're not sure how to remove a row from the main worksheet. I suspect I misunderstood you; you do know the VBA method to delete a row, don't you? I mean, I don't mind explaining it, but I gotta think that isn't what you need.

 

[Marc L]

As obviously all the settings must be achieved before the VBA event procedure runs, like the slicer if really necessary …​

​

 

[Juan Jacobs]

I have managed to fix the code and can confirm it works perfectly.

In order to use a slicer to filter data and then copy information based on the dropdown list to a new worksheet, use the following code.

>>> As You've noted <<<
>>> use code - tags <<<​

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim RngCriteria As Range

Set RngCriteria = Range("D:D")

If Intersect(RngCriteria, Target) Is Nothing Then
   
Else
   
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
   
    Dim lngLastRow As Long
    Dim ActiveSheet As Worksheet, InactiveSheet As Worksheet, PendingSheet As Worksheet, RenewedSheet As Worksheet, FollowUpSheet As Worksheet, RedZoneSheet As Worksheet
    Dim VarSource() As Variant, VarActive() As Variant, VarInactive() As Variant, VarPending() As Variant, VarRenewed() As Variant, VarFollowUp() As Variant, VarRedzone() As Variant
    Dim DblRowIndex As Double, DblColumnIndex As Double, DblCriteriaColumn As Double, DblActiveIndex As Double, DblInactiveIndex As Double, DblPendingIndex As Double, DblRenewedIndex As Double, DblFollowUpIndex As Double, DblRedzoneIndex As Double
   
    Set ActiveSheet = Sheets("Active")
    Set InactiveSheet = Sheets("Inactive")
    Set PendingSheet = Sheets("Pending")
    Set RenewedSheet = Sheets("Renewed")
    Set FollowUpSheet = Sheets("Follow Up")
    Set RedZoneSheet = Sheets("Red Zone")
   
    DblCriteriaColumn = 4
   
    lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
   
    VarSource = Range("A5", "R" & lngLastRow).Value2
   
    ReDim VarActive(1 To UBound(VarSource, 1), 1 To UBound(VarSource, 2))
    ReDim VarInactive(1 To UBound(VarSource, 1), 1 To UBound(VarSource, 2))
    ReDim VarPending(1 To UBound(VarSource, 1), 1 To UBound(VarSource, 2))
    ReDim VarRenewed(1 To UBound(VarSource, 1), 1 To UBound(VarSource, 2))
    ReDim VarFollowUp(1 To UBound(VarSource, 1), 1 To UBound(VarSource, 2))
    ReDim VarRedzone(1 To UBound(VarSource, 1), 1 To UBound(VarSource, 2))
   
    DblRowIndex = 1
   
    For DblColumnIndex = 1 To UBound(VarSource, 2)
       
        VarActive(DblRowIndex, DblColumnIndex) = VarSource(DblRowIndex, DblColumnIndex)
        VarInactive(DblRowIndex, DblColumnIndex) = VarSource(DblRowIndex, DblColumnIndex)
        VarPending(DblRowIndex, DblColumnIndex) = VarSource(DblRowIndex, DblColumnIndex)
        VarRenewed(DblRowIndex, DblColumnIndex) = VarSource(DblRowIndex, DblColumnIndex)
        VarFollowUp(DblRowIndex, DblColumnIndex) = VarSource(DblRowIndex, DblColumnIndex)
        VarRedzone(DblRowIndex, DblColumnIndex) = VarSource(DblRowIndex, DblColumnIndex)
       
    Next
   
    DblActiveIndex = 1
    DblInactiveIndex = 1
    DblPendingIndex = 1
    DblRenewedIndex = 1
    DblFollowUpIndex = 1
    DblRedzoneIndex = 1
   
    For DblRowIndex = 2 To UBound(VarSource, 1)
       
        Select Case VarSource(DblRowIndex, DblCriteriaColumn)
            Case Is = "Active"
               
                DblActiveIndex = DblActiveIndex + 1
               
                For DblColumnIndex = 1 To UBound(VarSource, 2)
                   
                    VarActive(DblActiveIndex, DblColumnIndex) = VarSource(DblRowIndex, DblColumnIndex)
                   
                Next
               
            Case Is = "Inactive"
               
                DblInactiveIndex = DblInactiveIndex + 1
               
                For DblColumnIndex = 1 To UBound(VarSource, 2)
                   
                    VarInactive(DblInactiveIndex, DblColumnIndex) = VarSource(DblRowIndex, DblColumnIndex)
                   
                Next
               
            Case Is = "Pending"
               
                DblPendingIndex = DblPendingIndex + 1
               
                For DblColumnIndex = 1 To UBound(VarSource, 2)
                   
                    VarPending(DblPendingIndex, DblColumnIndex) = VarSource(DblRowIndex, DblColumnIndex)
                   
                Next
               
            Case Is = "Renewed"
               
                DblRenewedIndex = DblRenewedIndex + 1
               
                For DblColumnIndex = 1 To UBound(VarSource, 2)
                   
                    VarRenewed(DblRenewedIndex, DblColumnIndex) = VarSource(DblRowIndex, DblColumnIndex)
                   
                Next
               
            Case Is = "Follow Up"
               
                DblFollowUpIndex = DblFollowUpIndex + 1
               
                For DblColumnIndex = 1 To UBound(VarSource, 2)
                   
                    VarFollowUp(DblFollowUpIndex, DblColumnIndex) = VarSource(DblRowIndex, DblColumnIndex)
                   
                Next
               
            Case Is = "Red Zone"
               
                DblRedzoneIndex = DblRedzoneIndex + 1
               
                For DblColumnIndex = 1 To UBound(VarSource, 2)
                   
                    VarRedzone(DblRedzoneIndex, DblColumnIndex) = VarSource(DblRowIndex, DblColumnIndex)
                   
                Next
               
        End Select
       
       
    Next
   
   
    ActiveSheet.Range("A1").Resize(UBound(VarActive, 1), UBound(VarActive, 2)).Value2 = VarActive
    InactiveSheet.Range("A1").Resize(UBound(VarInactive, 1), UBound(VarInactive, 2)).Value2 = VarInactive
    PendingSheet.Range("A1").Resize(UBound(VarPending, 1), UBound(VarPending, 2)).Value2 = VarPending
    RenewedSheet.Range("A1").Resize(UBound(VarRenewed, 1), UBound(VarRenewed, 2)).Value2 = VarRenewed
    FollowUpSheet.Range("A1").Resize(UBound(VarFollowUp, 1), UBound(VarFollowUp, 2)).Value2 = VarFollowUp
    RedZoneSheet.Range("A1").Resize(UBound(VarRedzone, 1), UBound(VarRedzone, 2)).Value2 = VarRedzone
   
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
   
End If

End Sub

 

[BobBridges]

Ain't it fun when you were struggling with something, and finally get it working?

There's a villain in the movie "Goldeneye", an evil Russian computer hacker named Boris, I think. He was a nasty character and he had to die, but I couldn't hate him properly because he'd work at some evil hacking program for a while, finally get it going, and leap to his feet, fists in the air and exult "YES! I am EENVEENCIBLE!!" I get just the same feeling.

 

[Juan Jacobs]

Ain't it fun when you were struggling with something, and finally get it working?

There's a villain in the movie "Goldeneye", an evil Russian computer hacker named Boris, I think. He was a nasty character and he had to die, but I couldn't hate him properly because he'd work at some evil hacking program for a while, finally get it going, and leap to his feet, fists in the air and exult "YES! I am EENVEENCIBLE!!" I get just the same feeling.

I completely agree and understand exactly what you are saying. I too leaped for joy and shouted out in excitement when i got it to work and i forgot i was not alone when i did so lol