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.
I created the vba code which has worked but its really slow.
I then inserted a slicer but now it is not working properly
The code is below:
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
I suggest to change the ActiveSheet name since it's already used by the application to identify, you know, the active sheet. Anyway, try using arrays. Here an example:
Option Explicit
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
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 Sub
It might be also wise to run the subroutine only when the proper column is changed. To achieve this, you might nest the previous code in an If statement like this:
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