How to properly reference a user control and dynamically add it to page?

Copy rows based on date

• QUESTION: The expert can't answer your question. Your Question was: I have lost the link to continue our dialogue but i have copied your last reply here. My follow up question was delivered to "Michelle Howell". Specifically we were discussing Copying rows to a new work sheet based on one of three dates. The three dates are in a columns J, K, and L of a worksheet named DataBase. The code you supplied worked great. Next I asked if future dates could be extracted from the "Database" worksheet based on time frame. Your Answer is below. To be more specific of my need I have a workbook that contains 3 worksheets, 1st worksheet named "Welcome" has several control buttons, one of which brings up a Userform that allows a user to enter vehicle data including the three dates we're discusssing. Information from the Userform populates the second worksheet "DataBase". Also on the "Welcome" worksheet there are other control buttons that allows a user to view which vehicles will require an inspection within a specified time frame (eg. 14 days, 30 days, and 45 days). Data returned when selecting "14 Day" control button should be those records whose date falls within 14 days of the system date. Data returned when selecting "30 Day" control button should be those records whose date falls within day 15 and day 30 from the system date. Data returned when selecting "45 Day" control button should be those records whose date falls within day 31 and day 45 from the system date. A new worksheet is added for each control button listing vehicles inspection that fall within the selected date range. Separate code for each control button is preferred. Tom's first Answer (This code extracted all rows that contained past - Expired - dates. Sub Expired() Sheets.Add.Name = "Expired" 'Add new worksheet Sheets("DataBase").Select 'Copies page layout from Database Cells.Select Selection.Copy Sheets("Expired").Select Cells.Select ActiveSheet.Paste Range("A2").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Application.CutCopyMode = False Selection.ClearContents Range("A2").Select Dim sh As Worksheet, sh1 As Worksheet 'Copy rows w/expired dates to new worksheet Dim r1 As Range, r As Range, r2 As Range Dim cell As Range, rw As Long Set sh = Worksheets("Database") Set sh1 = Worksheets("Expired") Set r1 = sh1.Cells(Rows.Count, "A").End(xlUp)(2) Set r = sh.Range("A2", sh.Cells(Rows.Count, "A").End(xlUp)) For Each cell In r rw = cell.Row With sh If (.Cells(rw, "J").Value 0) Or _ (.Cells(rw, "K").Value 0) Or _ (.Cells(rw, "L").Value 0) Then If r2 Is Nothing Then Set r2 = cell Else Set r2 = Union(r2, cell) End If End If End With Next If Not r2 Is Nothing Then r2.EntireRow.Copy r1 End If" Tom's second answer (for extracting future dates - code generates a syntax error") Tim I will assume by days out you mean you want to copy the records that have at least one of the 3 dates in the time period between now and the specified number of days from now. Sub copyData() Dim sh As Worksheet, sh1 As Worksheet Dim r1 As Range, r As Range, r2 As Range Dim cell As Range, rw As Long, res as Long Dim dtEnd as Date, dtStart as Date res = Application.InputBox("How many days out from today",type:=1) if res rw = cell.Row With sh if (.Cells(rw,"J").Value >= dtStart and .Cells(rw,"J").Value (.Cells(rw, "K").Value >= dtStart And .Cells(rw, "K").Value (.Cells(rw, "L").Value >= dtStart And .Cells(rw, "L").Value If r2 Is Nothing Then Set r2 = cell Else Set r2 = Union(r2, cell) End If End If End With Next If Not r2 Is Nothing Then r2.EntireRow.Copy r1 ' r2.EntireRow.Delete ' if you want to delete these records, then uncomment this line End If End Sub If you have a more precise definition of what you want to do, then feel free to follup with more information. If you want separate routines with hard code periods, then specify what those are. For example, if the 30 days out sheet is just the dates beyond 15 days out and less than or equal to 30 days out. Obviously, the code should be tested on a copy of your workbook to see if it performs as expected. -- Tom Ogilvy Tim, Must be a glitch in the system. Think this should have gone to: Tom Ogilvy I don't know of a way to forward to him. Sorry. Expert: Michelle Howell If you'd like to ask another question in the category, please come to http://www.allexperts.com/el/Excel/ This message is sent by an auto responder and cannot process replies. Allexperts.com ANSWER: Tim, these were tested and worked as I expected them to. Sub copyData14Day() Dim sh As Worksheet, sh1 As Worksheet Dim r1 As Range, r As Range, r2 As Range Dim cell As Range, rw As Long, res As Long Dim dtEnd As Date, dtStart As Date Dim bBool1 As Boolean, bBool2 As Boolean, bBool3 As Boolean dtStart = Date dtEnd = dtStart + 14 res = 14 Set sh = Worksheets("Database") Worksheets.Add After:=Worksheets(Worksheets.Count) Set sh1 = ActiveSheet sh1.Name = res & " days out" Set r1 = sh1.Cells(sh1.Rows.Count, "A").End(xlUp)(2) Set r = sh.Range("A2", sh.Cells(sh.Rows.Count, "A").End(xlUp)) For Each cell In r rw = cell.Row With sh If (.Cells(rw, "J").Value >= dtStart And .Cells(rw, "J").Value = dtStart And .Cells(rw, "K").Value = dtStart And .Cells(rw, "L").Value End With Next Application.Goto r2 r2.Select If Not r2 Is Nothing Then r2.EntireRow.Copy r1 ' r2.EntireRow.Delete ' if you want to delete these records, then uncomment this line End If End Sub Sub copyData30Day() Dim sh As Worksheet, sh1 As Worksheet Dim r1 As Range, r As Range, r2 As Range Dim cell As Range, rw As Long, res As Long Dim dtEnd As Date, dtStart As Date Dim bBool1 As Boolean, bBool2 As Boolean, bBool3 As Boolean dtStart = Date + 15 dtEnd = dtStart + 14 res = 30 Set sh = Worksheets("Database") Worksheets.Add After:=Worksheets(Worksheets.Count) Set sh1 = ActiveSheet sh1.Name = res & " days out" Set r1 = sh1.Cells(sh1.Rows.Count, "A").End(xlUp)(2) Set r = sh.Range("A2", sh.Cells(sh.Rows.Count, "A").End(xlUp)) For Each cell In r rw = cell.Row With sh If (.Cells(rw, "J").Value >= dtStart And .Cells(rw, "J").Value = dtStart And .Cells(rw, "K").Value = dtStart And .Cells(rw, "L").Value End With Next Application.Goto r2 r2.Select If Not r2 Is Nothing Then r2.EntireRow.Copy r1 ' r2.EntireRow.Delete ' if you want to delete these records, then uncomment this line End If End Sub Sub copyData45Day() Dim sh As Worksheet, sh1 As Worksheet Dim r1 As Range, r As Range, r2 As Range Dim cell As Range, rw As Long, res As Long Dim dtEnd As Date, dtStart As Date Dim bBool1 As Boolean, bBool2 As Boolean, bBool3 As Boolean dtStart = Date + 30 dtEnd = dtStart + 14 res = 45 Set sh = Worksheets("Database") Worksheets.Add After:=Worksheets(Worksheets.Count) Set sh1 = ActiveSheet sh1.Name = res & " days out" Set r1 = sh1.Cells(sh1.Rows.Count, "A").End(xlUp)(2) Set r = sh.Range("A2", sh.Cells(sh.Rows.Count, "A").End(xlUp)) For Each cell In r rw = cell.Row With sh If (.Cells(rw, "J").Value >= dtStart And .Cells(rw, "J").Value = dtStart And .Cells(rw, "K").Value = dtStart And .Cells(rw, "L").Value End With Next Application.Goto r2 r2.Select If Not r2 Is Nothing Then r2.EntireRow.Copy r1 ' r2.EntireRow.Delete ' if you want to delete these records, then uncomment this line End If End Sub ---------- FOLLOW-UP ---------- QUESTION: sorry to trouble you again, The code worked fine until today. When running the code for '14 days out" The program now generates a "Run-time error '5': Invalid procedure call or argument" at the line "Application.Goto r2". The error code does not occur within the code of "30 days out" or "45 days out". Any suggestions?

• Answer:

  Tim, that would indicate there is no data to copy for 14 days out. I believe I left some lines in the code that I was using to test it with (forgot to remove them) and these are causing the error. You can remove these lines from each routine: Application.Goto r2 r2.Select