Copy Data From One Sheet To Another, Based Upon Dates

F

fdegree

New Member
Joined
Jul 13, 2008
Messages
27
OK, per the advice of those on this board, I am posting snap shots of my page layouts…I hope it works and helps everyone understand.<!--[if !supportEmptyParas]--><!--[endif]--><o:p></o:p>
I am very new, so please be as simplistic and detailed as you can with your advice. I’m struggling enough as it is.<!--[if !supportEmptyParas]--><!--[endif]--><o:p></o:p>
Anyway, here is what I need. The user is trying to find the products that are due to be reordered within a specified “window”. So, on sheet 1, the user will enter the date of their next order. They will also enter how many days in advance they want to use, in order to find products that are due for reorder within this “window”. Using this date, and this number of days, I want the program to search all of the sheets in the workbook (1 for each customer – upwards of 50 customers) for “NEXT ORDER” (as shown on sheet 2) dates that fall within this “window”. In this example, the “window” is within 30 days from June 18.<!--[if !supportEmptyParas]--><!--[endif]--><o:p></o:p>
Once the “NEXT ORDER” dates are found, on each and every sheet, I want the program to get the following information from each sheet for each product that is due for reorder – CUSTOMERS NAME, PRODUCT, QUANTITY, and the NEXT ORDER date. Then enter this information on sheet 1. Thus, creating a list of products, and the associated customers, that are due to be reordered.<!--[if !supportEmptyParas]--><!--[endif]--><o:p></o:p>
Sheet 1<!--[if !supportEmptyParas]--><!--[endif]--><o:p></o:p><!--[if !supportEmptyParas]--><HTML><HEAD><Script Langage JavaScript></Script></HEAD><BODY BGCOLOR=#E0F4EA><CENTER><FONT COLOR=#339966 SIZE=5>[HtmlMaker 2.42]</FONT><BR><BR></CENTER><HR><BR><SPAN id='ForSubmit'>
Customers Orders.xls
ABCDEFGHIJK
1
2
3DateOfNextOrderJuly18,2008
4Productsforreorderwithinthenext:30Days
5
6CustomerProductQuantityNextOrder
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sheet1
</pre></SPAN></BODY></HTML>



Sheet 2<HTML><HEAD><Script Langage JavaScript></Script></HEAD><BODY BGCOLOR=#E0F4EA><CENTER><FONT COLOR=#339966 SIZE=5>[HtmlMaker 2.42]</FONT><BR><BR></CENTER><HR><BR><SPAN id='ForSubmit'>
Customers Orders.xls
ABCDEFGHIJKL
1
2
3Name:HomePhone:
4Address:WorkPhone:
5City:CellPhone:
6State:E-mail:
7Zip:Birthday:
8
9
10
11
12ProductQuantityLastOrderedDaysOfUseNextOrder
13RubyRedLipstick2July10,200845August24,2008
14GrassSeed3May5,200860July4,2008
15BaseballCards1June16,200840July26,2008
16KaratePoster5June30,200830July30,2008
17 
18 
19 
20 
21 
22 
23 
24 
Sheet 2
</SPAN></BODY></HTML></pre>
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Sort by date Sort by votes
Note: Be sure to try this on a copy of your worksheet and test it thoroughly before depending on it.
For this macro to work, the worksheet with the summary order on it (Sheet 1 in your snapshots) must be named 'Summary'. Code assumes all other pages contain customer data. Open the visual basic editor (Alt+F11), add a module to your workbook (Insert Module) then copy and paste the code into that module.
Code: 
Option Explicit

Sub CreateSummaryOrderWorksheet()

    Dim intSummaryDataRowFirst As Integer
    Dim intCustomerDataRowFirst As Integer
    Dim intCustomerDataRowLast As Integer
    Dim dteWindowStart As Date
    Dim dteWindowEnd As Date
    Dim intX As Integer
    Dim intY As Integer
    Dim intZ As Integer
    
    intSummaryDataRowFirst = 7
    intCustomerDataRowFirst = 13
    dteWindowStart = Worksheets("Summary").Range("I3")
    dteWindowEnd = dteWindowStart + Worksheets("Summary").Range("I4")
    
    'Clear existing summary data
    Worksheets("Summary").Select
    Range("B" & intSummaryDataRowFirst).Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    If Selection.Row >= intSummaryDataRowFirst Then
        Selection.EntireRow.Delete
    End If
    Range("B" & intSummaryDataRowFirst).Select
    
    intZ = intSummaryDataRowFirst
    For intX = 1 To Worksheets.Count
    
        If Worksheets(intX).Name <> "Summary" Then
            Worksheets(intX).Select
            Range("B" & intCustomerDataRowFirst).Select
            intCustomerDataRowLast = Range("B" & Rows.Count).End(xlUp).Row
            If intCustomerDataRowLast <= intSummaryDataRowFirst Then Exit For
            
            For intY = 0 To intCustomerDataRowLast - intCustomerDataRowFirst
                If Selection.Offset(intY, 8) >= dteWindowStart And _
                    Selection.Offset(intY, 8) <= dteWindowEnd Then
                    Worksheets("Summary").Range("B" & intZ) = _
                        Range("D3") 'Name
                    Worksheets("Summary").Range("D" & intZ) = _
                        Selection.Offset(intY, 0) 'Product
                    Worksheets("Summary").Range("F" & intZ) = _
                        Selection.Offset(intY, 2) 'Quantity
                    Worksheets("Summary").Range("H" & intZ) = _
                        Selection.Offset(intY, 8) 'Next Order
                    intZ = intZ + 1
                End If
            Next
        End If
    Next
    Worksheets("Summary").Select
End Sub

From the worksheet, Alt+F8 to display the Macro dialog. Select CreateSummaryOrderWorksheet. Click Run.
 
Upvote 0
Hi pbornemeier,

I tried what you said...surprisingly, I was able to execute everything as you described. Very good instructions. Unfortunately, it doesn't seemed to have copied anything to sheet 1...the Summary sheet (I did change the name of sheet 1 to "Summary").

When I ran the macro, the screen flashed VERY quickly with no results posted. In the 2 snap shots that I posted above, I would have expected the Baseball Cards and Karate Poster info to have been copied to the summary sheet, but nothing showed up.

Maybe I did something wrong???

I sincerely appreciate your efforts.
 
Upvote 0
I did get the Baseball Cards and Karate Poster items for the customers when I ran it. In reviewing the code, I did find an error in one line. Change the first line to the second
Code: 
If intCustomerDataRowLast <= intSummaryDataRowFirst Then Exit For 'incorrect

If intCustomerDataRowLast < intCustomerDataRowFirst Then Exit For 'corrected

Further review of the spreadsheet I created from your snapshots shows that I did not merge the customer data columns (BC, DE, FG, HI, JK) as you did. When I merged a customer worksheet, then my macro did not pick up the requirements for that customer. I attempted a quick change of my code taking the merged cells into account, but the .offset method does not work as I expected with merged cells.

If you unmerge rows 13 and down on your customer pages, the macro will work as is. I will look at it again tomorrow and see if I can modify it to work with then merged columns.
 
Upvote 0
This code may run a bit slower, but it can handle merged or unmerged customer data columns. Open the module as outlined previously and replace existing code with the following:
Code: 
Option Explicit

Sub CreateSummaryOrderWorksheet()

    Dim intSummaryDataRowFirst As Integer
    Dim intCustomerDataRowFirst As Integer
    Dim intCustomerDataRowLast As Integer
    Dim dteWindowStart As Date
    Dim dteWindowEnd As Date
    Dim intX As Integer
    Dim intY As Integer
    Dim intZ As Integer
    
    intSummaryDataRowFirst = 7
    intCustomerDataRowFirst = 13
    dteWindowStart = Worksheets("Summary").Range("I3")
    dteWindowEnd = dteWindowStart + Worksheets("Summary").Range("I4")
    
    'Clear existing summary data
    Worksheets("Summary").Select
    Range("B" & intSummaryDataRowFirst).Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    If Selection.Row >= intSummaryDataRowFirst Then
        Selection.EntireRow.Delete
    End If
    Range("B" & intSummaryDataRowFirst).Select
    
    intZ = intSummaryDataRowFirst
    For intX = 1 To Worksheets.Count
    
        If Worksheets(intX).Name <> "Summary" Then
            Worksheets(intX).Select
            Range("B" & intCustomerDataRowFirst).Select
            intCustomerDataRowLast = Range("B" & Rows.Count).End(xlUp).Row
            If intCustomerDataRowLast < intCustomerDataRowFirst Then Exit For
            
            For intY = intCustomerDataRowFirst To intCustomerDataRowLast
                If Range("J" & intY) >= dteWindowStart And _
                    Range("J" & intY) <= dteWindowEnd Then
                    Worksheets("Summary").Range("B" & intZ) = _
                        Range("D3")       'Name
                    Worksheets("Summary").Range("D" & intZ) = _
                        Range("B" & intY) 'Product
                    Worksheets("Summary").Range("F" & intZ) = _
                        Range("D" & intY) 'Quantity
                    Worksheets("Summary").Range("H" & intZ) = _
                        Range("J" & intY) 'Next Order
                    Worksheets("Summary").Range("H" & intZ).NumberFormat = _
                        "mmmm dd, yyyy"   'Next Order date format
                    intZ = intZ + 1
                End If
            Next
        End If
    Next
    Worksheets("Summary").Select
End Sub
 
Upvote 0
I appreciate everything you have done. No time this morning to try your other suggestions...I have to get to work. But, when I get home, I will work on it. I'll let you know how it goes.

Thanks again.
 
Upvote 0
Thank you so much, it works perfectly...after I unmerged those cells. Which is not at all a problem. I sincerely appreciate your expertise.

Now for one other question...Is there a way to have the macro run continously in the background, without having to hit Alt+F8 each time? So, as soon as the dates are changed, it will immediately update the summary.

If not, it's no big deal...I'm more curious than anything.

Thanks again!!!
 
Upvote 0
You are welcome - glad to help. I made a change in the macro so that it can run when it is triggered -- which will be whenever you activate the Summary page. Having it run in tha background all of the time would get very annoying since there would be at least a short pause after each cell was changed. Make the 2 changes below:

1) Add this statement to the Summary code page
Code: 
Private Sub Worksheet_Activate()
    CreateSummaryOrderWorksheet
End Sub

2) Replace the existing code with:
Code: 
Sub CreateSummaryOrderWorksheet()

    Dim intSummaryDataRowFirst As Integer
    Dim intCustomerDataRowFirst As Integer
    Dim intCustomerDataRowLast As Integer
    Dim dteWindowStart As Date
    Dim dteWindowEnd As Date
    Dim intX As Integer
    Dim intY As Integer
    Dim intZ As Integer
    
    intSummaryDataRowFirst = 7
    intCustomerDataRowFirst = 13
    dteWindowStart = Worksheets("Summary").Range("I3")
    dteWindowEnd = dteWindowStart + Worksheets("Summary").Range("I4")
    
    'Clear existing summary data
    Worksheets("Summary").Select
    Range("B" & intSummaryDataRowFirst).Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    If Selection.Row >= intSummaryDataRowFirst Then
        Selection.EntireRow.Delete
    End If
    Range("B" & intSummaryDataRowFirst).Select
    
    intZ = intSummaryDataRowFirst
    For intX = 1 To Worksheets.Count
    
        If Worksheets(intX).Name <> "Summary" Then
            intCustomerDataRowLast = Worksheets(intX).Range("B" & Rows.Count).End(xlUp).Row
            If intCustomerDataRowLast < intCustomerDataRowFirst Then Exit For
            
            For intY = intCustomerDataRowFirst To intCustomerDataRowLast
                If Worksheets(intX).Range("J" & intY) >= dteWindowStart And _
                    Worksheets(intX).Range("J" & intY) <= dteWindowEnd Then
                    Worksheets("Summary").Range("B" & intZ) = _
                        Worksheets(intX).Range("D3")       'Name
                    Worksheets("Summary").Range("D" & intZ) = _
                        Worksheets(intX).Range("B" & intY) 'Product
                    Worksheets("Summary").Range("F" & intZ) = _
                        Worksheets(intX).Range("D" & intY) 'Quantity
                    Worksheets("Summary").Range("H" & intZ) = _
                        Worksheets(intX).Range("J" & intY) 'Next Order
                    Worksheets("Summary").Range("H" & intZ).NumberFormat = _
                        "mmmm dd, yyyy"   'Next Order date format
                    intZ = intZ + 1
                End If
            Next
        End If
    Next
End Sub
 
Last edited:
Upvote 0
OK, so far everything is going nicely...thanks again.

I am doing all of this for my wife, and now she wants one more thing. She would like another sheet, labeld Birthdays, that will show customers names and birthdays that fall within a specified "window". The code can be written based upon the exact same layout as shown in the above snapshots. But, instead the information returning to the Summary sheet, it will return to a new sheet called Birthdays.
 
Upvote 0
Glad it is working out OK.
1) I had to make a change to the previous code to allow it to work with another non-customer worksheet. I also added a subroutine to do the birthday calculations.

2) Replace the previous code with these subroutines:
Code: 
Sub CreateSummaryOrderWorksheet()

    Dim intSummaryDataRowFirst As Integer
    Dim intCustomerDataRowFirst As Integer
    Dim intCustomerDataRowLast As Integer
    Dim dteWindowStart As Date
    Dim dteWindowEnd As Date
    Dim intX As Integer
    Dim intY As Integer
    Dim intZ As Integer
    
    intSummaryDataRowFirst = 7
    intCustomerDataRowFirst = 13
    dteWindowStart = Worksheets("Summary").Range("I3")
    dteWindowEnd = dteWindowStart + Worksheets("Summary").Range("I4")
    
    'Clear existing summary data
    Worksheets("Summary").Select
    Range("B" & intSummaryDataRowFirst).Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    If Selection.Row >= intSummaryDataRowFirst Then
        Selection.EntireRow.Delete
    End If
    Range("B" & intSummaryDataRowFirst).Select
    
    intZ = intSummaryDataRowFirst
    For intX = 1 To Worksheets.Count
        
        If InStr("   Summary   Birthday   ", Worksheets(intX).Name) = 0 Then
            'Worksheets(intX).Select
            'Range("B" & intCustomerDataRowFirst).Select
            intCustomerDataRowLast = _
                Worksheets(intX).Range("B" & Rows.Count).End(xlUp).Row
            If intCustomerDataRowLast < intCustomerDataRowFirst Then Exit For
            
            For intY = intCustomerDataRowFirst To intCustomerDataRowLast
                If Worksheets(intX).Range("J" & intY) >= dteWindowStart And _
                    Worksheets(intX).Range("J" & intY) <= dteWindowEnd Then
                    Worksheets("Summary").Range("B" & intZ) = _
                        Worksheets(intX).Range("D3")       'Name
                    Worksheets("Summary").Range("D" & intZ) = _
                        Worksheets(intX).Range("B" & intY) 'Product
                    Worksheets("Summary").Range("F" & intZ) = _
                        Worksheets(intX).Range("D" & intY) 'Quantity
                    Worksheets("Summary").Range("H" & intZ) = _
                        Worksheets(intX).Range("J" & intY) 'Next Order
                    Worksheets("Summary").Range("H" & intZ).NumberFormat = _
                        "mmmm dd, yyyy"   'Next Order date format
                    intZ = intZ + 1
                End If
            Next
        End If
    Next
End Sub

Sub CreateBirthdayWorksheet()

    Dim intBirthdayRowFirst As Integer
    Dim dteWindowStart As Date
    Dim dteWindowEnd As Date
    Dim intX As Integer
    Dim intZ As Integer
    
    intBirthdayRowFirst = 7
    dteWindowStart = Worksheets("Birthdays").Range("I3")
    dteWindowEnd = dteWindowStart + Worksheets("Birthdays").Range("I4")
    
    'Clear existing Birthday data
    Worksheets("Birthdays").Select
    Range("B" & intBirthdayRowFirst).Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    If Selection.Row >= intBirthdayRowFirst Then
        Selection.EntireRow.Delete
    End If
    Range("B" & intBirthdayRowFirst).Select
    
    intZ = intBirthdayRowFirst
    For intX = 1 To Worksheets.Count
        
        If InStr("   Summary   Birthdays   ", Worksheets(intX).Name) = 0 Then
            If Worksheets(intX).Range("J7") >= dteWindowStart And _
                Worksheets(intX).Range("J7") <= dteWindowEnd Then
                Worksheets("Birthdays").Range("B" & intZ) = _
                    Worksheets(intX).Range("D3")       'Name
                Worksheets("Birthdays").Range("D" & intZ) = _
                    Worksheets(intX).Range("J7") 'Birthday
                Worksheets("Birthdays").Range("D" & intZ).NumberFormat = _
                    "mmmm dd, yyyy"   'Birthday date format
                intZ = intZ + 1
            End If
        End If
    Next
End Sub
2) On the Birthdays worksheet, I3 must contain the start date for the Birthday window and I4 the size of the birthday window. Add the following code to the Birthdays codesheet.
3) When you activate the Summary or Birthdays worksheet, their data will be recalculated based on the input date in cells I3 & I4 on their page, as well as the data contained in the customer worksheets.
Code: 
Option Explicit

Private Sub Worksheet_Activate()
    CreateBirthdayWorksheet
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

wo_ofberry
  • Question
Run Time Error - Copying data from one workbook to another based on different headers as well as their positions
Replies
8
Views
438
mumps
mumps
M
  • Question
Help with FilterXML formula
Replies
0
Views
1K
montex01
M
Y
  • Question
extracting data from 2 sheets to one sheet
Replies
0
Views
343
Ymmirx
Y
V
  • Question
Extract multiple data from one sheet to another
Replies
3
Views
473
vishu
V
P
  • Question
Need Help with VBA for copying cell data from one sheet to another sheet in specific cells based on matching the Month and Year of Date
Replies
1
Views
822
aaewalsh
aaewalsh

Forum statistics

Threads
1,215,028
Messages
6,122,753
Members
449,094
Latest member
dsharae57

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top