Input Box to search and copy from multiple sheets

J

jessigem

New Member
Joined
Apr 5, 2016
Messages
6
Hello,

I currently have a macro set up that triggers an Input Box to input a range of dates. Once entered, it scans through the reference sheet and copies and pastes a specified range of cells from any rows containing a date within the input range.

I've been trying to edit this macro to trigger an Input Box that will ask for a specific order number, and once entered it needs to scan two sheets for the order number and copy and paste the same range of cells from any rows containing the order number.

It's the same basic purpose of the current macro, but I can't seem to get the code right to reference multiple sheets. I've researched it for a few days now and I can't find a solution that fits the bill.

Below is the current macro. The copy/paste ranges and destination need to stay the same. I just need to change the input box to search for an exact match (not case-sensitive) and the sheet sources would be "Ontario" and "San Diego" (or Sheet1 and Sheet2). Sheets are in the same workbook.

Code: 
Sub Ontario_Releases()Dim startdate As Date, enddate As Date
    Dim rng As Range, destRow As Long
    Dim shtSrc As Worksheet, shtDest As Worksheet
    Dim c As Range


    Set shtSrc = Sheets("Ontario")
    Set shtDest = Sheets("RELEASE SCHEDULE")


    destRow = 3


    startdate = CDate(InputBox("Beginning Date"))
    enddate = CDate(InputBox("End Date"))


    Set rng = Application.Intersect(shtSrc.Range("J:Y"), shtSrc.UsedRange)


    For Each c In rng.Cells
        If c.Value >= startdate And c.Value <= enddate Then
            Sheet1.Range("B" & c.Row).Copy
                shtDest.Cells(destRow, 4).PasteSpecial Paste:=xlPasteValues
                    Sheet1.Range("D" & c.Row, "G" & c.Row).Copy
                        shtDest.Cells(destRow, 5).PasteSpecial Paste:=xlPasteValues
                            Sheet1.Range("Z" & c.Row).Copy
                                shtDest.Cells(destRow, 11).PasteSpecial Paste:=xlPasteValues
                            Range(c, c.Offset(0, 1)).Copy
                                shtDest.Cells(destRow, 9).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                                    destRow = destRow + 1
        End If
    Next
End Sub
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Sort by date Sort by votes
Try something like this (not tested).

Code: 
[COLOR=darkblue]Sub[/COLOR] Ontario_Releases()
    [COLOR=darkblue]Dim[/COLOR] startdate [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Date[/COLOR], enddate [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Date[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] rng [COLOR=darkblue]As[/COLOR] Range, destRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] shtSrc [COLOR=darkblue]As[/COLOR] Worksheet, shtDest [COLOR=darkblue]As[/COLOR] Worksheet
    [COLOR=darkblue]Dim[/COLOR] c [COLOR=darkblue]As[/COLOR] Range
    
    [B][COLOR=green]'Set shtSrc = Sheets("Ontario")[/COLOR][/B]
    [COLOR=darkblue]Set[/COLOR] shtDest = Sheets("RELEASE SCHEDULE")
    
    destRow = 3
    
    startdate = [COLOR=darkblue]CDate[/COLOR](InputBox("Beginning Date"))
    enddate = [COLOR=darkblue]CDate[/COLOR](InputBox("End Date"))
    
[B]    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] shtSrc [COLOR=darkblue]In[/COLOR] Sheets(Array("Ontario", "San Diego"))[/B]
        
        [COLOR=darkblue]Set[/COLOR] rng = Application.Intersect(shtSrc.Range("J:Y"), shtSrc.UsedRange)
        
        [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] c [COLOR=darkblue]In[/COLOR] rng.Cells
            [COLOR=darkblue]If[/COLOR] c.Value >= startdate And c.Value <= enddate [COLOR=darkblue]Then[/COLOR]
                [B]shtSrc[/B].Range("B" & c.Row).Copy
                shtDest.Cells(destRow, 4).PasteSpecial Paste:=xlPasteValues
                
                [B]shtSrc[/B].Range("D" & c.Row, "G" & c.Row).Copy
                shtDest.Cells(destRow, 5).PasteSpecial Paste:=xlPasteValues
                
                [B]shtSrc[/B].Range("Z" & c.Row).Copy
                shtDest.Cells(destRow, 11).PasteSpecial Paste:=xlPasteValues
                
                [B]shtSrc[/B].Range(c, c.Offset(0, 1)).Copy
                shtDest.Cells(destRow, 9).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                
                destRow = destRow + 1
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        [COLOR=darkblue]Next[/COLOR]
        
[B]    [COLOR=darkblue]Next[/COLOR] shtSrc[/B]
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
Upvote 0
AlphaFrog said:
Try something like this (not tested).

Code: 
[COLOR=darkblue]Sub[/COLOR] Ontario_Releases()
    [COLOR=darkblue]Dim[/COLOR] startdate [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Date[/COLOR], enddate [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Date[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] rng [COLOR=darkblue]As[/COLOR] Range, destRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] shtSrc [COLOR=darkblue]As[/COLOR] Worksheet, shtDest [COLOR=darkblue]As[/COLOR] Worksheet
    [COLOR=darkblue]Dim[/COLOR] c [COLOR=darkblue]As[/COLOR] Range
    
    [B][COLOR=green]'Set shtSrc = Sheets("Ontario")[/COLOR][/B]
    [COLOR=darkblue]Set[/COLOR] shtDest = Sheets("RELEASE SCHEDULE")
    
    destRow = 3
    
    startdate = [COLOR=darkblue]CDate[/COLOR](InputBox("Beginning Date"))
    enddate = [COLOR=darkblue]CDate[/COLOR](InputBox("End Date"))
    
[B]    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] shtSrc [COLOR=darkblue]In[/COLOR] Sheets(Array("Ontario", "San Diego"))[/B]
        
        [COLOR=darkblue]Set[/COLOR] rng = Application.Intersect(shtSrc.Range("J:Y"), shtSrc.UsedRange)
        
        [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] c [COLOR=darkblue]In[/COLOR] rng.Cells
            [COLOR=darkblue]If[/COLOR] c.Value >= startdate And c.Value <= enddate [COLOR=darkblue]Then[/COLOR]
                [B]shtSrc[/B].Range("B" & c.Row).Copy
                shtDest.Cells(destRow, 4).PasteSpecial Paste:=xlPasteValues
                
                [B]shtSrc[/B].Range("D" & c.Row, "G" & c.Row).Copy
                shtDest.Cells(destRow, 5).PasteSpecial Paste:=xlPasteValues
                
                [B]shtSrc[/B].Range("Z" & c.Row).Copy
                shtDest.Cells(destRow, 11).PasteSpecial Paste:=xlPasteValues
                
                [B]shtSrc[/B].Range(c, c.Offset(0, 1)).Copy
                shtDest.Cells(destRow, 9).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                
                destRow = destRow + 1
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        [COLOR=darkblue]Next[/COLOR]
        
[B]    [COLOR=darkblue]Next[/COLOR] shtSrc[/B]
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
Click to expand...

That works perfectly in terms of referencing both sheets. Thank you! :)

But the Input Box is still set to search for a range of dates. I need it to search for a specific order number upon input (text will always be formatted as R-#####, if that matters). It can't be case-sensitive in case the person who enters the data forgets to capitalize the R in the order number, and it can't be a partial search because there are other number strings on the sheet that do not begin with R- that might come up with the same string of numbers. I've tried to modify it myself and I can't get the search specifics right.
 
Upvote 0
I totally skipped over the order number bit.

Change the A:A to the column that has the order numbers to search.

Code: 
[COLOR=darkblue]Sub[/COLOR] Ontario_Releases()
    [COLOR=darkblue]Dim[/COLOR] OrderNumber [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] destRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] shtSrc [COLOR=darkblue]As[/COLOR] Worksheet, shtDest [COLOR=darkblue]As[/COLOR] Worksheet
    [COLOR=darkblue]Dim[/COLOR] c [COLOR=darkblue]As[/COLOR] Range
    
    [COLOR=darkblue]Set[/COLOR] shtDest = Sheets("RELEASE SCHEDULE")
    
    destRow = 3
    
    OrderNumber = Application.InputBox("Enter an order number.", "Order Number Search", Type:=2)
    [COLOR=darkblue]If[/COLOR] OrderNumber = "False" [COLOR=darkblue]Then[/COLOR] [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR] [COLOR=green]'User canceled[/COLOR]
    
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] shtSrc [COLOR=darkblue]In[/COLOR] Sheets(Array("Ontario", "San Diego"))
        
        [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] c [COLOR=darkblue]In[/COLOR] shtSrc.UsedRange.Columns("[COLOR=#ff0000]A:A[/COLOR]").Cells
        
            [COLOR=darkblue]If[/COLOR] LCase(OrderNumber) = LCase(c.Value) [COLOR=darkblue]Then[/COLOR]
                shtSrc.Range("B" & c.Row).Copy
                shtDest.Cells(destRow, 4).PasteSpecial Paste:=xlPasteValues
                
                shtSrc.Range("D" & c.Row, "G" & c.Row).Copy
                shtDest.Cells(destRow, 5).PasteSpecial Paste:=xlPasteValues
                
                shtSrc.Range("Z" & c.Row).Copy
                shtDest.Cells(destRow, 11).PasteSpecial Paste:=xlPasteValues
                
                shtSrc.Range(c, c.Offset(0, 1)).Copy
                shtDest.Cells(destRow, 9).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                
                destRow = destRow + 1
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        [COLOR=darkblue]Next[/COLOR]
        
    [COLOR=darkblue]Next[/COLOR] shtSrc
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
Last edited:
Upvote 0
AlphaFrog said:
Code: 
[COLOR=darkblue]Sub[/COLOR] Ontario_Releases()
    [COLOR=darkblue]Dim[/COLOR] OrderNumber [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] destRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] shtSrc [COLOR=darkblue]As[/COLOR] Worksheet, shtDest [COLOR=darkblue]As[/COLOR] Worksheet
    [COLOR=darkblue]Dim[/COLOR] c [COLOR=darkblue]As[/COLOR] Range
    
    [COLOR=darkblue]Set[/COLOR] shtDest = Sheets("RELEASE SCHEDULE")
    
    destRow = 3
    
    OrderNumber = Application.InputBox("Enter an order number.", "Order Number Search", Type:=2)
    [COLOR=darkblue]If[/COLOR] OrderNumber = "False" [COLOR=darkblue]Then[/COLOR] [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR] [COLOR=green]'User canceled[/COLOR]
    
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] shtSrc [COLOR=darkblue]In[/COLOR] Sheets(Array("Ontario", "San Diego"))
        
        [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] c [COLOR=darkblue]In[/COLOR] shtSrc.UsedRange.Columns("[COLOR=#ff0000]A:A[/COLOR]").Cells
        
            [COLOR=darkblue]If[/COLOR] LCase(OrderNumber) = LCase(c.Value) [COLOR=darkblue]Then[/COLOR]
                shtSrc.Range("B" & c.Row).Copy
                shtDest.Cells(destRow, 4).PasteSpecial Paste:=xlPasteValues
                
                shtSrc.Range("D" & c.Row, "G" & c.Row).Copy
                shtDest.Cells(destRow, 5).PasteSpecial Paste:=xlPasteValues
                
                shtSrc.Range("Z" & c.Row).Copy
                shtDest.Cells(destRow, 11).PasteSpecial Paste:=xlPasteValues
                
                shtSrc.Range(c, c.Offset(0, 1)).Copy
                shtDest.Cells(destRow, 9).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                
                destRow = destRow + 1
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        [COLOR=darkblue]Next[/COLOR]
        
    [COLOR=darkblue]Next[/COLOR] shtSrc
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
Click to expand...


That works beautifully :) Thank you!
 
Upvote 0
You must log in or register to reply here.

Similar threads

Q
  • Solved
How to stop InputBox from looping after input?
Replies
7
Views
277
qplsn9
Q
Agnarr
  • Question
VBA problem with creating new sheets
Replies
0
Views
450
Agnarr
Agnarr
T
  • Question
Copy row values from one worksheet in one workbook to multiple workbooks based on file name
Replies
0
Views
190
thechad
T
M
  • Question
Copy & Paste Value based on input box
Replies
3
Views
432
rlv01
R
gheyman
  • Solved
Copy from one workbook to another (just format and values)
Replies
2
Views
464
gheyman
gheyman

Forum statistics

Threads
1,216,128
Messages
6,129,030
Members
449,482
Latest member
al mugheen

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