Automatically find, cut and paste

[lesliew]

Hello - I have a worksheet where I track people who cancel policies. The contents in column G determines where I need the information to go. There are 3 options-Cancelled, In Process, Saved. I want my worksheet to automatically copy the entire row and paste it into separate worksheets named after the 3 options. Is there a way to automatically sort it by date after the entries are entered? My column A is the date they contacted me.

Thanks!

 

[Simon Lloyd]

This will do what you want, although it won't sort by date as you havent said which column the dates are in!

Sub Copy_data_To_Named_Sheets()
    Dim wSheetStart As Worksheet
    Dim strText As String
    Dim rngSource As Range, rngUnique As Range
    Dim rngSourceLess As Range
     
    Set wSheetStart = ActiveSheet
    wSheetStart.AutoFilterMode = False
    Set rngSource = Range("G1", Range("G" & Rows.Count).End(xlUp))
    Set rngSourceLess = Range("G2", Range("G" & Rows.Count).End(xlUp))
     
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("UniqueList").Delete
    Worksheets.Add().Name = "UniqueList"
     
    With Worksheets("UniqueList")
         
        rngSource.AdvancedFilter xlFilterCopy, rngSource, .Range("G1"), True
        Set rngUnique = .Range("G2", .Range("G" & .Rows.Count).End(xlUp))
    End With
    
    On Error GoTo 0
     
    For Each cell In rngUnique
         
        With wSheetStart
             
            rngSource.AutoFilter Field:=1, Criteria1:=cell.Value
            rngSourceLess.SpecialCells(xlCellTypeVisible).EntireRow.Copy _
            Destination:=Worksheets(cell.Value).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
             
            If cell.Value = "" Then Exit For
            .AutoFilterMode = False
        End With
    Next cell
     
    wSheetStart.AutoFilterMode = False
    Sheets("UniqueList").Delete
    Application.DisplayAlerts = True
     
End Sub

 

[Peter_SSs]

lesliew

Welcome to the MrExcel board!

I have assumed:
- that the three destination sheets already exist (if not, please advise)
- that your original data is on a sheet called "Original". (Modify this to suit)

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> SplitData()<br>    <SPAN style="color:#00007F">Dim</SPAN> i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    mysheet = Array("Cancelled", "In Process", "Saved")<br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    <SPAN style="color:#00007F">For</SPAN> i = 0 <SPAN style="color:#00007F">To</SPAN> <SPAN style="color:#00007F">UBound</SPAN>(mysheet)<br>        Worksheets("Original").UsedRange.Copy _<br>            Destination:=Worksheets(mysheet(i)).Range("A1")<br>        <SPAN style="color:#00007F">With</SPAN> Worksheets(mysheet(i)).UsedRange<br>            .AutoFilter field:=7, Criteria1:="<>" & .Parent.Name<br>            .Offset(1).EntireRow.Delete<br>            .AutoFilter<br>            .Columns.AutoFit<br>            .Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlYes<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> i<br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[lesliew]

Thanks for the help! I used Simons code since I did this before the second post was there and it worked. Now I have another question relating to the code. Is there a way for the macro to run after each entry? Or is there a button I can add to the worksheet to get the program to run? Oh and the date I wanted everything sorted by is in column A.

This is great! I am so happy right now!

 

[Simon Lloyd]

DO your sort manually and record your actions then experiment as to where it should go in the code as for a button goto VIEW|TOOLBAR|FORMS and drag a button to your menubar then assign a macro, you dont want the code to run every time because it will copy ALL the data again and again every time a cell is changed!