0

I am somewhat of a novice VBA user and I have created a workbook that has a Userform with several tabs. When the user selects the appropriate tab and inputs data it gets transferred to the applicable worksheet. I have a command button on a worksheet that when clicked it prompts for a date range and then I want it to extract the transferred data from each applicable worksheet and place it onto separate new worksheets for each user (because everyone's data is different). The below VBA code I have compiled is not processing correctly. Instead it only pulls data from one worksheet and puts it on all of the new individual worksheets. 

Sub Copy_Click() Dim startdate As Date, enddate As Date Dim rng As Range, destRow As Long Dim shtSrc1 As Worksheet Dim shtSrc2 As Worksheet Dim shtSrc3 As Worksheet Dim shtDest1 As Worksheet Dim shtDest2 As Worksheet Dim shtDest3 As Worksheet Dim c As Range Set shtSrc1 = Sheets("Recruiter") Set shtSrc2 = Sheets("SrRecruiter") Set shtSrc3 = Sheets("RecruiterSpc") Set shtDest1 = Sheets("Extract_Recrt") Set shtDest2 = Sheets("Extract_SrRecrt") Set shtDest3 = Sheets("Extract_RecrtSpc") destRow = 2 'start copying to this row startdate = CDate(InputBox("Input desired start date for report data")) enddate = CDate(InputBox("Input desired end date for report data")) 'don't scan the entire column... Set rng = Application.Intersect(shtSrc1.Range("A:A"), shtSrc1.UsedRange) Set rng = Application.Intersect(shtSrc2.Range("A:A"), shtSrc2.UsedRange) Set rng = Application.Intersect(shtSrc3.Range("A:A"), shtSrc3.UsedRange) For Each c In rng.Cells If c.Value >= startdate And c.Value <= enddate Then c.Offset(0, 0).Resize(1, 25).Copy _ shtDest1.Cells(destRow, 1) c.Offset(0, 0).Resize(1, 25).Copy _ shtDest2.Cells(destRow, 1) c.Offset(0, 0).Resize(1, 25).Copy _ shtDest3.Cells(destRow, 1) destRow = destRow + 1 End If Next End Sub

Can anyone please show me what I'm doing wrong and how to fix it.

Improve this question

2 Answers 2

Reset to default
1

Firstly it looks like you are setting the rng variable and then overwriting it. I would change the code to something like this to accommodate the 3 rng variables that seem to be needed.

ie,

Dim rng(1 To 3) Set rng(1) = Application.Intersect(shtSrc1.Range("A:A"), shtSrc1.UsedRange) Set rng(2) = Application.Intersect(shtSrc2.Range("A:A"), shtSrc2.UsedRange) Set rng(3) = Application.Intersect(shtSrc3.Range("A:A"), shtSrc3.UsedRange)

Then use a for loop to loop through each range you just set. The complete code is below for reference.

Sub Copy_Click() 　Dim startdate As Date, enddate As Date Dim rng(1 To 3) As Range, destRow As Long Dim shtSrc1 As Worksheet Dim shtSrc2 As Worksheet Dim shtSrc3 As Worksheet Dim shtDest(1 To 3) As Worksheet Dim c As Range Set shtSrc1 = Sheets("Recruiter") Set shtSrc2 = Sheets("SrRecruiter") Set shtSrc3 = Sheets("RecruiterSpc") Set shtDest(1) = Sheets("Extract_Recrt") Set shtDest(2) = Sheets("Extract_SrRecrt") Set shtDest(3) = Sheets("Extract_RecrtSpc") destRow = 2 'start copying to this row startdate = CDate(InputBox("Input desired start date for report data")) enddate = CDate(InputBox("Input desired end date for report data")) If IsDate(stardate) = False Then Exit Sub 'don't scan the entire column... Set rng(1) = Application.Intersect(shtSrc1.Range("A:A"), shtSrc1.UsedRange) Set rng(2) = Application.Intersect(shtSrc2.Range("A:A"), shtSrc2.UsedRange) Set rng(3) = Application.Intersect(shtSrc3.Range("A:A"), shtSrc3.UsedRange) For i = LBound(rng) To UBound(rng) For Each c In rng(i).Cells If c.Value >= startdate And c.Value <= enddate Then c.Offset(0, 0).Resize(1, 25).Copy _ shtDest(i).Cells(destRow, 1) destRow = destRow + 1 End If Next Next i End Sub
Improve this answer
Sign up to request clarification or add additional context in comments.

1 Comment

Thank you for explaining about separate ranges. Unfortunately, the code provided is combining all the information and repeating/placing it onto each of the new individual sheets. Instead once a date range is input for all sheets, I need the data to pull from each applicable sheet for the given date and transfer on a new sheet for each applicable role type (i.e., Recruiter data pulled and place on new sheet, Sr. Recruiter data pulled and placed on new sheet. Please help...thank you
0

not so sure about your needs but you can try this

Option Explicit Sub Copy_Click() Dim startdate As Date, enddate As Date Dim rng As Range, c As Range Dim destRow(1 To 3) As Long Dim shtSrc(1 To 3) As Worksheet Dim shtDest(1 To 3) As Worksheet Dim i As Long Set shtSrc(1) = Sheets("Recruiter") Set shtSrc(2) = Sheets("SrRecruiter") Set shtSrc(3) = Sheets("RecruiterSpc") Set shtDest(1) = Sheets("Extract_Recrt") Set shtDest(2) = Sheets("Extract_SrRecrt") Set shtDest(3) = Sheets("Extract_RecrtSpc") destRow(1) = 2: destRow(2) = 2: destRow(3) = 2 startdate = CDate(InputBox("Input desired start date for report data")) enddate = CDate(InputBox("Input desired end date for report data")) For i = 1 To 3 Set rng = shtSrc(i).Range("A:A").SpecialCells(xlCellTypeConstants, xlNumbers) 'this will select only numbers constants. since dates are numbers they'll get into this range For Each c In rng If c.Value >= startdate And c.Value <= enddate Then c.Offset(0, 0).Resize(1, 25).Copy Destination:=shtDest(i).Cells(destRow(i), 1) destRow(i) = destRow(i) + 1 End If Next c Next i End Sub
Improve this answer

6 Comments

YES!!!! Thank you soooo very much. This is exactly what I needed/wanted and it works perfectly. It even overwrites the existing data with the new data. Many thanks to all users of this forum who take time out of their busy schedules to help others, it is so greatly appreciated! :)
Glad it helped. If I fullfilled your question, please mark my answer as the solution. Thank you
I am unsure of how to mark your answer as the solution....do I need to do something special to the post?
User3598756--I have one additional issue I'd like to ask if you could help me solve. I'd like to use the same kind of theory to pull monthly data. I may not be able to post all of my issue in this comment but I'll try. I want to have a command button that when clicked prompts the user to enter a begin/end date to pull data from specific columns from multiple sheets and transfer the results to a master tab. I think I'm overcomplicating how to go about this. Can you please provide direction.
So using the same code you modified for me earlier, I want to pull from each of the six sheets based on a begin/end date but I want to extract from specific columns only and transfer the results to one sheet destination. Thank you.
|

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.