Hello,
I'm attempting to run a macro that will filter data in a worksheet, create a new sheet, copy random rows copy and paste the rows selected to the new sheet. My filter Sub is functioning fine, my create a new sheet Sub is also working just fine. However, when I attempt the run the Sub to randomly selet rows, copy, and paste the data to the new sheet I receive the Run-time error. I've looked over my code and it appears to be right, so I'm not sure what is creating the error. I've seen the line of code creating the error, and it's indicating the end of the line is where the error lies. I was hoping someone might be able to help me with this. My ActiveSheet is the sheet where the data is located. The line of code creating the error is: Set TargetRows = Union(TargetRows, ActiveSheet.Rows(RowArr(i))). The bold portion of the line is where the error lies. I've added the entire code below.
Any help anyone can offer me would be greatly appreciated. Thank you.
D.
I'm attempting to run a macro that will filter data in a worksheet, create a new sheet, copy random rows copy and paste the rows selected to the new sheet. My filter Sub is functioning fine, my create a new sheet Sub is also working just fine. However, when I attempt the run the Sub to randomly selet rows, copy, and paste the data to the new sheet I receive the Run-time error. I've looked over my code and it appears to be right, so I'm not sure what is creating the error. I've seen the line of code creating the error, and it's indicating the end of the line is where the error lies. I was hoping someone might be able to help me with this. My ActiveSheet is the sheet where the data is located. The line of code creating the error is: Set TargetRows = Union(TargetRows, ActiveSheet.Rows(RowArr(i))). The bold portion of the line is where the error lies. I've added the entire code below.
Code:
Sub Filter_by_month()
'
' Filter_by_month Macro
ActiveSheet.Range("A:M").AutoFilter Field:=7, Criteria1:=xlFilterThisMonth, _
Operator:=xlFilterDynamic
End Sub
Sub AddSheets()
Sheets.Add After:=Sheets(Sheets.Count)
End Sub
Sub Row_Selection()
'Define the Start and End of the data range
Const STARTROW As Long = 1
Dim LastRow As Long
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
'Create an Array - Length = Number of Rows in the data
Dim RowArr() As Long
ReDim RowArr(STARTROW To LastRow)
'Fill the Array - Each element is a row #
Dim i As Long
For i = LBound(RowArr) To UBound(RowArr)
RowArr(i) = i
Next i
'Shuffle the Row #'s within the Array
Randomize
Dim tmp As Long, RndNum As Long
For i = LBound(RowArr) To UBound(RowArr)
RndNum = WorksheetFunction.Floor((UBound(RowArr) - LBound(RowArr) + 1) * Rnd, 1) + LBound(RowArr)
tmp = RowArr(i)
RowArr(i) = RowArr(RndNum)
RowArr(RndNum) = tmp
Next i
'Calculate the number of rows to divvy up
Const LIMIT As Double = 0.1 '10%
Dim Size As Long
Size = WorksheetFunction.Ceiling((UBound(RowArr) - LBound(RowArr) + 1) * LIMIT, 1)
If Size > UBound(RowArr) Then Size = UBound(RowArr)
'Collect the chosen rows into a range
Dim TargetRows As Range
For i = LBound(RowArr) To UBound(RowArr) + Size
If TargetRows Is Nothing Then
Set TargetRows = ActiveSheet.Rows(RowArr(i))
Else
Set TargetRows = Union(TargetRows, ActiveSheet.Rows(RowArr(i)))
End If
Next i
'Define the Output Location
Dim OutPutRange As Range
Set OutPutRange = Sheet1.Cells(1, 1) 'Top Left Corner
'Copy the randomly chosen rows to the output location
TargetRows.Copy Destination:=OutPutRange.Resize(TargetRows.Rows.Count).EntireRow
End Sub
Any help anyone can offer me would be greatly appreciated. Thank you.
D.