Help with VB for Filtering

fiesta

Board Regular
Joined
Nov 4, 2005
Messages
84
Hi,
I have a main sheet, "sheet1" which I filter using the AutoFilter on the Data
Menu along with the VB coding I copied from a book i'm reading. ie:
Sub Copy_with_Autofilter()
Dim rng As Range

With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng = .Offset((1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.Copy _
Sheets("Sheet2").Range("A6")
End With
End Sub

The coding works very well, with one exception, it overwrites any data thats
already in sheet2.
Is there any code that I can add to the above so that it will automatically
add data to the next empty row in sheet2.
Will be grateful for any help.
 

acw

MrExcel MVP
Joined
Feb 13, 2004
Messages
4,814
Hi

Try changing
Sheets("Sheet2").Range("A6")
to
Sheets("Sheet2").Range("A" & sheets("sheet2").cells(rows.count,"A").end(xlup).row +1)


Tony
 

fiesta

Board Regular
Joined
Nov 4, 2005
Messages
84
Hi Tony
Thanks very much, that works perfect.
Can I ask you another question on the same subject, is it possible to
automate the Autofilter procedure without using the Data Menu and if so
have you any idea what the VB coding would be.
Thanks once again for you help.
 

acw

MrExcel MVP
Joined
Feb 13, 2004
Messages
4,814
Hi

What do you mean by "automate the autofilter"? You can set the autofilter along the lines of
range("a1").autofilter
and turn it of
activesheet.autofiltermode = false

Tony
 

fiesta

Board Regular
Joined
Nov 4, 2005
Messages
84
Hi
Sorry Tony
In my Sheet1 are Racehorse Results that I download every day which I then filter via two coloumns D & F D=Distance & F=Age.
ie: D =5f & F =3yo this would then go in sheet2 there would be 12 sheets
altogether.
sheet2=5f, sheet3=6f and so on.
Is there any way that can be automated with VB code.
Thanks
 

acw

MrExcel MVP
Joined
Feb 13, 2004
Messages
4,814
Hi

So you want to split the data fromsheet1 into 12 other sheets, based on certain requirements for each of the sheets?

If so:
1) What happens to any existing data on the output sheets
2) where are the relevant criteria for each sheet, and are they fixed / variable.
3) How do you want this to happen? On the press of a button, or whenever the workbook is opened???
4) How much data is there on sheet1, and how much is being copied to the output sheets?

Probably more questions but.....


Tony
 

Nimrod

MrExcel MVP
Joined
Apr 29, 2002
Messages
6,259
fiesta
Your example is just a little unclear to me. :rolleyes:

You have 12 sheets that you want to copy filtered data from .... correct ?
Each of these 12 sheets should be copied to "Sheet2" ... correct ?
What criteria would you use from each sheet ??
 

fiesta

Board Regular
Joined
Nov 4, 2005
Messages
84
Hi Tony
Yes thats right , the data in sheet1 will be split into 12 other sheets based
on the criteria in (2) under.

1) I want to keep all the existing data on the output sheets.
2) The relevant criteria is in Sheet1 column "D" and are variables.
ie: 5f, 6f, 7f, 1m, 1m2f, 1m4f, 1m5f, 2m, 2yo5f, 2yo6f, 2yo7f
and 2yo1m.
3) Ideally pressing a button.
4) At the moment just the daily download which would never be more
than 10 rows a day filtered to the appropriate sheets (12).
Hope this helps and thanks once again.
Sorry for the delay.
 

Nimrod

MrExcel MVP
Joined
Apr 29, 2002
Messages
6,259
How it works...
Procedure Goes does Column D of the Sheet "Sheet1". It then looks for a Sheet name that matches the Value in Column D. If the sheet is found it then automatically copies the row to the Target Sheet. If the sheet is not found it will ask the user if it wants the sheet made and the info copied to it.

Assumptions:
1- Source Sheet name is "Sheet1"

Code:
Public Sub CopyHorseData()
    With Sheets("Sheet1")
    For rw = 2 To Cells(65536, 4).End(xlUp).Row
        If Len(Trim(.Cells(rw, 4).Value)) > 0 Then
        If SheetExists(.Cells(rw, 4).Value) Then
            .Cells(rw, 4).EntireRow.Copy
            With Sheets(.Cells(rw, 4).Value)
            .Paste Destination:=.Range("A" & .Cells(65536, 4).End(xlUp).Row + 1)
            End With
        End If
        End If
    Next rw
    End With
    
    Application.CutCopyMode = False
End Sub

Private Function SheetExists(sname) As Boolean
'   Returns TRUE if sheet exists in the active workbook
    Dim OrigSh As String
    Dim x As Object
    
    OrigSh = ActiveSheet.Name
    On Error Resume Next
    Set x = ActiveWorkbook.Sheets(sname)
    If Err = 0 Then
        SheetExists = True
    Else
        ln1 = "The Sheet " & sname & " does not exist." & vbNewLine
        ln2 = "Do you want to make sheet and copy data ?"
        Style = vbQuestion + vbYesNo
        Title = "Make New Sheet"
        msg = ln1 & ln2
        
        If MsgBox(msg, Style, Title) = vbYes Then
            Application.ScreenUpdating = False
            Sheets.Add
            ActiveSheet.Name = sname
            SheetExists = True
            Sheets(OrigSh).Activate
            Application.ScreenUpdating = True
            Else
            SheetExists = False
            
        End If
    End If
End Function
 

fiesta

Board Regular
Joined
Nov 4, 2005
Messages
84
Help with VB coding for filtering

Hi Nimrod
Sorry for the delay in answering.
Your coding works perfectly after a minor adjustment to my data.
I would like to thank you very much for your help its very much
appreciated.
 

Forum statistics

Threads
1,077,864
Messages
5,336,846
Members
399,105
Latest member
idleminutes

Some videos you may like

This Week's Hot Topics

Top