SOLVED

Moving Rows to different sheets based on future dates.

Copper Contributor

I have created a form for several people to enter scheduling requests.  I need a macro to move rows from the form sheet to different sheets based on the date of the schedule request without needing to cut and paste each individual row as they come in.  I recorded a macro to move each line but I can't figure out how to make it on going and based on the date.

5 Replies
best response confirmed by Michelle365 (Copper Contributor)
Solution

@Michelle365 

Try this:

Sub MoveRows()
    Dim ws As Worksheet
    Dim wt As Worksheet
    Dim tbl As ListObject
    Dim n As String
    Dim r As ListRow
    Dim m As Long
    Dim t As Long
    Application.ScreenUpdating = False
    Set ws = Worksheets("Form1")
    Set tbl = ws.ListObjects(1)
    For Each r In tbl.ListRows
        n = Format(r.Range(1, 1).Value, "dddd, mmmm d, yyyy")
        Set wt = Nothing
        On Error Resume Next
        Set wt = Worksheets(n)
        On Error GoTo 0
        If wt Is Nothing Then
            Set wt = Worksheets.Add(After:=Worksheets(Worksheets.Count))
            wt.Name = n
            tbl.HeaderRowRange.Copy Destination:=wt.Range("A1")
        End If
        t = wt.Range("A" & wt.Rows.Count).End(xlUp).Row + 1
        r.Range.Copy Destination:=wt.Range("A" & t)
    Next r
    tbl.DataBodyRange.Delete
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

@Michelle365 

 

You are of course free to design this as you wish. But allow me, if you don't mind, to present a macro-free alternative. Excel over the last year or so introduced several new "Dynamic Array" functions. FILTER is one of them. 

 

By using FILTER, in the formula that appears below (and is in the attached revised version of your spreadsheet), you can just enter a date and immediately see all of the entries from your form that pertain to that date. If you want to sort them, you could do so. In fact, you could readily create a more sophisticated version of the formula to show all of the tasks for the next three days. Here's the basic formula that would enable you to have just two spreadsheets in the workbook, one being your form, the other this spreadsheet.

=FILTER(Table1,Table1[Schedule Date]='FILTERED dates'!A2,"No tasks scheduled")

By the way, one feature of Dynamic Array formulas is that they are only entered in the upper left cell of the target destination. They fill, below and to the right, with all relevant data. So this formula is only entered in cell C2.

 

FILTER does require the most recent version of Excel. And to set your mind at ease, I kept your macro-enabled spreadsheet intact, so it's still all there. Just wanted to demonstrate how the desired functionality could be achieved without needing the macro.

I appreciate that, but there are just too many hands in the pot for that. We need it to be idiot proof for others to come in and make edits to each sheet as well. Moving things to a new sheet is what others involved would like. Thanks.

@Michelle365 

 

Well, I wish you well. What you're describing would raise red flags in my mind. i spend many years as the director of  a major database project for a major corporation. One of the key goals in database design--which is what  you have--is something called "data integrity." One of the best ways to weaken or, as the worst case, destroy data integrity is to have what is supposed to be the same entry--e.g., an address--appear in multiple places with the ability to edit it one place but remain as it was in the other(s). 

 

The more idiot proof approach, frankly (IMHO), is to allow edits only in the master database.

Thanks Hans, this is working perfectly.
1 best response

Accepted Solutions
best response confirmed by Michelle365 (Copper Contributor)
Solution

@Michelle365 

Try this:

Sub MoveRows()
    Dim ws As Worksheet
    Dim wt As Worksheet
    Dim tbl As ListObject
    Dim n As String
    Dim r As ListRow
    Dim m As Long
    Dim t As Long
    Application.ScreenUpdating = False
    Set ws = Worksheets("Form1")
    Set tbl = ws.ListObjects(1)
    For Each r In tbl.ListRows
        n = Format(r.Range(1, 1).Value, "dddd, mmmm d, yyyy")
        Set wt = Nothing
        On Error Resume Next
        Set wt = Worksheets(n)
        On Error GoTo 0
        If wt Is Nothing Then
            Set wt = Worksheets.Add(After:=Worksheets(Worksheets.Count))
            wt.Name = n
            tbl.HeaderRowRange.Copy Destination:=wt.Range("A1")
        End If
        t = wt.Range("A" & wt.Rows.Count).End(xlUp).Row + 1
        r.Range.Copy Destination:=wt.Range("A" & t)
    Next r
    tbl.DataBodyRange.Delete
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

View solution in original post