Forum Discussion
Moving Rows to different sheets based on future dates.
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.
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
5 Replies
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.
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.
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- Thanks Hans, this is working perfectly.
