Copy and paste entire rows from data sheet based on two criteria within user form

ambquinn · May 21st 2017

Excel 2007 VBA assistance.
Would appreciate any help with this one as it is driving me mad. I can find VBA code to copy and paste rows based on a hard-coded array or specific values. However, I have a user form which allows the selection of any one staff member and any input date and I can't get it working.

Basically I have a huge "Sales" sheet, from which I want to be able to copy and paste entire rows into a "Summary" sheet based on two chosen criteria (Staff name & date of sales) via a userform when the "Submit" commandbutton is clicked.

I then also want to be able to email the "summary" spreadsheet only by clicking another commandbutton, "Email", but I should be okay with this part myself.

Source spreadsheet Name: "Sales"
Column A Staff Name Column B Date of Sales
Data starts row 9

Destination spreadsheet name: "Summary"
CommandButton: brings up user form
Listbox1: list of staff names to select
Textbox1: date to input re sales

"Submit" Commandbutton - want to copy and paste entire rows based on staff name and specific date from "Sales" spreadsheet (from row 9) into "Summary" spreadsheet (from row 9)

As I said, any help would be greatly appreciated!!!
Many thanks

**KjBox** · May 21st 2017

Re: Copy and paste entire rows from data sheet based on two criteria within user for

Try this, you do not say what the "Submit" CommandButton is named, if not "CommandButton1" you will need to change the macro name to suit ( Private Sub ActualCommandButtonName_Click() ).

Code

Private Sub CommandButton1_Click()
    '// Change name of command button to suit
    
    Dim x, y, i As Long, ii As Long, iii As Long, lRow As Long, lCol As Long
    
    With Sheets("Sales")
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        lCol = .Cells(9, .Columns.Count).End(xlToLeft).Column
        x = .Range(.Cells(9, 1), .Cells(lRow, lCol))
    End With
    ReDim y(1 To UBound(x, 2), 1 To 1)
    
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) Then
            For ii = 1 To UBound(x, 1)
                If x(ii, 1) = ListBox1.List(i) And x(ii, 2) = CDate(TextBox1) Then
                    If y(1, 1) <> "" Then ReDim Preserve y(1 To UBound(x, 2), 1 To UBound(y, 2) + 1)
                    For iii = 1 To UBound(x, 2)
                        y(iii, UBound(y, 2)) = x(ii, iii)
                    Next
                End If
            Next
        End If
    Next
    
    With Sheets("Summary")
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Rows("9:" & lRow).Clear
        .[a2].Resize(UBound(y, 2), UBound(y, 1)) = Application.Transpose(y)
    End With
        
End Sub

Display More

**KjBox** · May 21st 2017

Re: Copy and paste entire rows from data sheet based on two criteria within user for

The code I just posted was for a multiselect List Box. If you are not using multiselect (just one staff name can be selected in the list) then try this

Code

Private Sub CommandButton1_Click()
    '// Change name of command button to suit
    
    Dim x, y, i As Long, ii As Long, iii As Long, lRow As Long, lCol As Long
    
    With Sheets("Sales")
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        lCol = .Cells(9, .Columns.Count).End(xlToLeft).Column
        x = .Range(.Cells(9, 1), .Cells(lRow, lCol))
    End With
    ReDim y(1 To UBound(x, 2), 1 To 1)
    
    For ii = 1 To UBound(x, 1)
        If x(ii, 1) = ListBox1.List(ListBox1.ListIndex) And x(ii, 2) = CDate(TextBox1) Then
            If y(1, 1) <> "" Then ReDim Preserve y(1 To UBound(x, 2), 1 To UBound(y, 2) + 1)
            For iii = 1 To UBound(x, 2)
                y(iii, UBound(y, 2)) = x(ii, iii)
            Next
        End If
    Next
    
    With Sheets("Summary")
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Rows("9:" & lRow).Clear
        .[a2].Resize(UBound(y, 2), UBound(y, 1)) = Application.Transpose(y)
    End With
        
End Sub

Display More

sktneer · May 21st 2017

Re: Copy and paste entire rows from data sheet based on two criteria within user for

KjBox as offered a pretty smart solution.

Here is another approach with Autofilter. Modify it to your need.

Assuming the name of the submit commandbutton is cmdSubmit and other controls are named as TextBox1 and ListBox1.

Code

Private Sub cmdSubmit_Click()
Dim wsSource As Worksheet, wsDest As Worksheet
Dim CritDate As String
Dim StaffName
Dim lr As Long, lc As Long, i As Long


Application.ScreenUpdating = False


Set wsSource = Sheets("Sales")
Set wsDest = Sheets("Summary")


lr = wsSource.UsedRange.Rows.Count
lc = wsSource.UsedRange.Columns.Count


wsDest.Cells.Clear


For i = 0 To Me.ListBox1.ListCount - 1
    If Me.ListBox1.Selected(i) Then
        StaffName = ListBox1.List(i)
        Exit For
    End If
Next i
If StaffName = "" Then
    MsgBox "You didn't select a Staff Name from the ListBox.", vbExclamation, "Staff Name Not Selected!"
    Exit Sub
End If


CritDate = Me.TextBox1.Value


If CritDate = "" Then
    MsgBox "You didn't specify a date in the TextBox.", vbExclamation, "Date Not Specified!"
    Exit Sub
End If


CritDate = Format(CritDate, "mm/dd/yyyy")


wsSource.AutoFilterMode = False


'Assuming Row9 is the header row on Sales sheet
With wsSource.Rows(9)
    .AutoFilter field:=2, Criteria1:="=" & CritDate, Operator:=xlAnd
    .AutoFilter field:=1, Criteria1:=StaffName, Operator:=xlFilterValues
    wsSource.Range(wsSource.Cells(9, 1), wsSource.Cells(lr, lc)).SpecialCells(xlCellTypeVisible).Copy wsDest.Range("A1")
    .AutoFilter
End With
Unload Me
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Display More

**KjBox** · May 21st 2017

Re: Copy and paste entire rows from data sheet based on two criteria within user for

Thanks, sktneer.

I always find using arrays to be much faster that autofilter, especially if multiple filtering is needed. If the data set starts to get big (250,000 + rows and/or 1,000 columns) then an ADO connection between the tables and SQL commands is by far the fastest method.

ambquinn · May 21st 2017

Re: Copy and paste entire rows from data sheet based on two criteria within user for

[FONT=&quot]Firstly - many thanks!

KjBox - brilliant, (I used the first). The only really minor thing is that the data is being copied into the first row of the summary sheet, (which overwrites info already there). However, it is such a minor thing & I'll figure it out, am so happy to have code that actually works and works so well!

[/FONT]

ambquinn · May 21st 2017

Re: Copy and paste entire rows from data sheet based on two criteria within user for

sktneer - I'm interested in your code too, (as I have never used autofilter). However, even when a name has been selected in the list box and a date entered, the warning boxes still come up. I'm prob doing something really thick, but would appreciate your advice as I want to get my head around this.

But huge thanks to both!

sktneer · May 21st 2017

Re: Copy and paste entire rows from data sheet based on two criteria within user for

Quote from KjBox;792703

Thanks, sktneer.

I always find using arrays to be much faster that autofilter, especially if multiple filtering is needed. If the data set starts to get big (250,000 + rows and/or 1,000 columns) then an ADO connection between the tables and SQL commands is by far the fastest method.

I completely agree with you.

Regards.

sktneer · May 21st 2017

Re: Copy and paste entire rows from data sheet based on two criteria within user for

Quote from ambquinn;792705

sktneer - I'm interested in your code too, (as I have never used autofilter). However, even when a name has been selected in the list box and a date entered, the warning boxes still come up. I'm prob doing something really thick, but would appreciate your advice as I want to get my head around this.

But huge thanks to both!

You're welcome ambquinn! Glad we could help.

**KjBox** · May 21st 2017

Re: Copy and paste entire rows from data sheet based on two criteria within user for

You're welcome.

My mistake with the Summary sheet issue, sorry.

Change

Code

With Sheets("Summary")
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Rows("9:" & lRow).Clear
        .[a2].Resize(UBound(y, 2), UBound(y, 1)) = Application.Transpose(y)
    End With

to

Code

With Sheets("Summary")
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Rows("9:" & lRow).Clear
        .[a9].Resize(UBound(y, 2), UBound(y, 1)) = Application.Transpose(y)
    End With

ambquinn · May 21st 2017

Re: Copy and paste entire rows from data sheet based on two criteria within user for

Perfect! Many thanks - you have saved me such a lot of frustration

**KjBox** · May 22nd 2017

Re: Copy and paste entire rows from data sheet based on two criteria within user for

You're welcome.

Copy and paste entire rows from data sheet based on two criteria within user form

Participate now!

Share

Users Viewing This Thread