Filter sort in using VBA

[tojomojo]

I've got a simple spread sheet where I am using a pull down box list to select a staff member and then all their sorted tasks should appear on another sheet. It just doesn't populate the target sheet (sheet 4).....

VBA attached to sheet with all tasks and pull down is;

Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby Extendoffice
On Error Resume Next
If Not Intersect(Range("E2"), Target) Is Nothing Then
Application.EnableEvents = False
If Range("E2").Value = "" Then
Worksheets("Sheet4").ShowAllData
Else
Worksheets("Sheet4").Range("E2").AutoFilter 5, Range("E2").Value
End If
Application.EnableEvents = True
End If
End Sub

 

[tojomojo]

Managed to get the clear going which has highlighted the main issue in that when the A1 is selected to set the value for moving the data to the other sheets, it now moves the same data to all the sheets. I looked at the IF's and I think the code below is right. Seems to work!! Any howling errors?

Private Sub Worksheet_Change(ByVal Target As Range)
        
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub


Application.ScreenUpdating = False
Application.EnableEvents = False


If Target.Value = "KG" Then
With Range("C3:C" & Range("C" & Rows.Count).End(xlUp).Row)
        .AutoFilter 1, Target.Value
        Sheets("KG list").Cells.Clear
        .SpecialCells(12).EntireRow.Copy Sheets("KG list").[A4]
        Sheets("KG list").Columns.AutoFit
        .AutoFilter
     End With
            End If
        
 If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub


Application.ScreenUpdating = False
Application.EnableEvents = False


If Target.Value = "SD" Then
With Range("C3:C" & Range("C" & Rows.Count).End(xlUp).Row)
        .AutoFilter 1, Target.Value
         Sheets("SD list").Cells.Clear
        .SpecialCells(12).EntireRow.Copy Sheets("SD list").[A4]
        Sheets("SD list").Columns.AutoFit
        .AutoFilter
            
End With
            End If
        
       If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub


Application.ScreenUpdating = False
Application.EnableEvents = False


If Target.Value = "OM" Then
With Range("C3:C" & Range("C" & Rows.Count).End(xlUp).Row)
        .AutoFilter 1, Target.Value
         Sheets("OM list").Cells.Clear
        .SpecialCells(12).EntireRow.Copy Sheets("OM list").[A4]
        Sheets("OM list").Columns.AutoFit
        .AutoFilter


 End With
            End If
        
        




Application.CutCopyMode = False
Application.EnableEvents = True
Application.ScreenUpdating = True
 
 
End Sub

 

[MARK858]

The

If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub

you only need the once (the one at the start of the sub) and as I have already stated the

Application.CutCopyMode = False

does nothing as it is not in CutCopyMode.

 

[MARK858]

More importantly the

 Application.ScreenUpdating = False
    Application.EnableEvents = False

should only be there once (at the start of the code).

 

[vcoolio]

Hello Tojomojo,

Its good to see that you have made a major effort to sort this out for yourself and that it works ok for you.

However, you don't need all that code to do what you are wanting to do. The code as follows will suffice:-

Private Sub Worksheet_Change(ByVal Target As Range)
        
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub

Application.ScreenUpdating = False
Application.EnableEvents = False

With Range("C3", Range("C" & Rows.Count).End(xlUp))
        .AutoFilter 1, Target.Value
        Sheets(Target.Value).Cells.Clear
        .SpecialCells(12).EntireRow.Copy Sheets(Target.Value).[A4]
        Sheets(Target.Value).Columns.AutoFit
        .AutoFilter
End With

Application.EnableEvents = True
Application.ScreenUpdating = True
 
End Sub

Once you select a value from the drop down in A1, the code will filter for all instances of that value and then transfer all the relevant rows of data to the relevant sheet.
Following is the link to your latest workbook sample with this code implemented:-

http://ge.tt/1WdhRTu2

Also, you will need to make sure that the drop down values match exactly with the sheet tab names. I see that you've already done this in Column C.

I hope that this helps.

Cheerio,
vcoolio.

 

[MARK858]

vcoolio, you need to append " list" to the sheet name to match the sheet names....

.SpecialCells(12).EntireRow.Copy Sheets(Target.Value & " list").[A4]

 

[vcoolio]

Yes. Good move Mark.

Just trying to show the OP some proper method/uniformity and regularity for naming for the sake of better code function.

I've used (wild card):

 "*" & "Criteria" & "*"

a number of times (reasonably successful) in code but this can be prone to bugging out dependent on the criteria type. Hence the note to keep things uniform.

The OP could actually use Column C as the target to trigger the code rather than use a separate trigger (cell A1).

Cheerio,
vcoolio.

 

[tojomojo]

Mark

Sorry im a bit confused with your statement......

'you need to append 'list ' to the sheet name to match the sheet names'. Do you mean it should just read KG list etc. and not just list?

Thanks again guys. Learning all the time.....
****** id="cke_pastebin" style="position: absolute; top: 0px; width: 1px; height: 1px; overflow: hidden; left: -1000px;">vcoolio, you need to append " list" to the sheet name to match the sheet names....</body>

 

[MARK858]

The .SpecialCells line from vcoolio's code should read as I have it in my post.

 

[tojomojo]

Guys

Sorry, been away for a bit...

One more issue.

The new code with Marks mod pulls up the target OK and assigns it to Target.Value but when I debug it crashes at

 Sheets(Target.Value).Cells.Clear

and I cant see why.

full code is...

Private Sub Worksheet_Change(ByVal Target As Range)        
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub


Application.ScreenUpdating = False
Application.EnableEvents = False


With Range("C3", Range("C" & Rows.Count).End(xlUp))
        .AutoFilter 1, Target.Value
        Sheets(Target.Value).Cells.Clear
'        .SpecialCells(12).EntireRow.Copy Sheets(Target.Value).[A4]
        .SpecialCells(12).EntireRow.Copy Sheets(Target.Value & " list").[A4]
        Sheets(Target.Value).Columns.AutoFit
        .AutoFilter
End With


Application.EnableEvents = True
Application.ScreenUpdating = True
 
End Sub

.......

 

[MARK858]

If SpecialCells doesn't find a match (i.e. no visible cells in the range) it will crash with no error handling as I have already stated in a previous post.
What goes the error message state?

Why do you need the .Cells?