Copy and Past Code

J

Jamm_027

Board Regular
Joined
Sep 10, 2007
Messages
249
I have a userform with 3 comboboxes. The code below takes what is selected in each combobox and one at a time filters the data found on sheet (Download) and then copies and paste the filtered data onto another sheet (View).

The code works perfectly if the use makes selections in all 3 comboboxes. However, I need to amend the code so that if the user makes a selection in only combobox1 and leaves 2 and 3 blank the code skip the copy and paste function for the blank comboboxes.

Code: 
Private Sub CommandButton1_Click()

    Application.ScreenUpdating = False
    
    'Place all data from userform1 to Tables
    
    Sheets("Sheet2").Range("aa1").Value = UserForm1.ComboBox1.Value
    Sheets("Sheet2").Range("ab1").Value = UserForm1.ComboBox2.Value
    Sheets("Sheet2").Range("AC1").Value = UserForm1.ComboBox3.Value
    
    Unload Me
    
    Sheets("View").Range("A4:P10000").ClearContents
    
    'Filter combobox 1

    With Sheets("Download").Range("A1:O5000")
    
        .AutoFilter

        If Sheets("Sheet2").Range("AA1").Value <> "" Then
            .AutoFilter Field:=1, Criteria1:=Sheets("Sheet2").Range("AA1").Value
        Else
                .AutoFilter Field:=1
        End If
    
 'Copy and Paste Filter 1
        .Range("A1:P1000").SpecialCells(xlCellTypeVisible).Copy Sheets("View").Range("A3")
    
'Filter Combobox 2
        .AutoFilter

        If Sheets("Sheet2").Range("AB1").Value <> "" Then
            .AutoFilter Field:=1, Criteria1:=Sheets("Sheet2").Range("AB1").Value
        Else
            .AutoFilter Field:=1
        End If
    
'find first empty row in database
    Dim ws As Worksheet
    Set ws = Worksheets("View")
    Dim iRow As Long
    iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    
'Copy and Paste Filter 2
        .Range("A2:P1000").SpecialCells(xlCellTypeVisible).Copy Sheets("View").Cells(iRow, "A")
    End With


    'Filter combobox 3

        With Sheets("Download").Range("A1:O5000")
   
        .AutoFilter

        If Sheets("Sheet2").Range("AC1").Value <> "" Then
            .AutoFilter Field:=1, Criteria1:=Sheets("Sheet2").Range("AC1").Value
        Else
                .AutoFilter Field:=1
        End If
        
    'find first empty row in database
    'Dim ws As Worksheet
    'Set ws = Worksheets("View")
    'Dim iRow As Long
    iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    
'Copy and Paste Filter 2
        .Range("A2:P1000").SpecialCells(xlCellTypeVisible).Copy Sheets("View").Cells(iRow, "A")
    End With

Sheets("View").Select
Application.ScreenUpdating = True
    
End Sub
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Sort by date Sort by votes
decklun

decklun

Board Regular
Joined
Dec 4, 2006
Messages
126
You could write each section of the code beginning with an "IF" and to run the section if the value does not equal ""

Will this work for you? (since I do not have the data you are working with I am unable to test)

Code: 
Private Sub CommandButton1_Click()

Application.ScreenUpdating = False

Sheets("View").Range("A4:P10000").ClearContents
    
'Filter combobox 1
If UserForm1.ComboBox1.Value <> "" Then
    Sheets("Sheet2").Range("aa1").Value = UserForm1.ComboBox1.Value
        With Sheets("Download").Range("A1:O5000")
            .AutoFilter
            If Sheets("Sheet2").Range("AA1").Value <> "" Then
                .AutoFilter Field:=1, Criteria1:=Sheets("Sheet2").Range("AA1").Value
            Else
                .AutoFilter Field:=1
            End If
            'Copy and Paste Filter 1
            .Range("A1:P1000").SpecialCells(xlCellTypeVisible).Copy Sheets("View").Range("A3")
        End With
End If
 
'Filter Combobox 2
If UserForm1.ComboBox2.Value <> "" Then
    Sheets("Sheet2").Range("ab1").Value = UserForm1.ComboBox2.Value
    With Sheets("Download").Range("A1:O5000")
        .AutoFilter
        If Sheets("Sheet2").Range("AB1").Value <> "" Then
            .AutoFilter Field:=1, Criteria1:=Sheets("Sheet2").Range("AB1").Value
        Else
            .AutoFilter Field:=1
        End If

        'find first empty row in database
        Dim ws As Worksheet
        Set ws = Worksheets("View")
        Dim iRow As Long
        iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

        'Copy and Paste Filter 2
        .Range("A2:P1000").SpecialCells(xlCellTypeVisible).Copy Sheets("View").Cells(iRow, "A")
    End With
End If

'Filter combobox 3
If UserForm1.ComboBox3.Value <> "" Then
    Sheets("Sheet2").Range("AC1").Value = UserForm1.ComboBox3.Value
    With Sheets("Download").Range("A1:O5000")
        .AutoFilter
        If Sheets("Sheet2").Range("AC1").Value <> "" Then
            .AutoFilter Field:=1, Criteria1:=Sheets("Sheet2").Range("AC1").Value
        Else
            .AutoFilter Field:=1
        End If
        'find first empty row in database
        'Dim ws As Worksheet
        'Set ws = Worksheets("View")
        'Dim iRow As Long
        iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        'Copy and Paste Filter 2
        .Range("A2:P1000").SpecialCells(xlCellTypeVisible).Copy Sheets("View").Cells(iRow, "A")
    End With
End If

Unload Me

Sheets("View").Select
Application.ScreenUpdating = True
    
End Sub
 
Upvote 0
J

Jamm_027

Board Regular
Joined
Sep 10, 2007
Messages
249
Thanks for the response Decklun.

Here is how I solved it.

Code: 
Private Sub CommandButton1_Click()

    Application.ScreenUpdating = False
    
    'Place all data from userform1 to Tables
    
    Sheets("Sheet2").Range("aa1").Value = UserForm1.ComboBox1.Value
    Sheets("Sheet2").Range("ab1").Value = UserForm1.ComboBox2.Value
    Sheets("Sheet2").Range("AC1").Value = UserForm1.ComboBox3.Value
    
    Unload Me
    
    Sheets("View").Range("A4:L10000").ClearContents
    
    'Filter combobox 1

    With Sheets("Download").Range("A1:M5000")
    
        .AutoFilter

        If Sheets("Sheet2").Range("AA1").Value <> "" Then
            .AutoFilter Field:=1, Criteria1:=Sheets("Sheet2").Range("AA1").Value
        Else
                .AutoFilter Field:=1
        End If
    
 'Copy and Paste Filter 1
        .Range("A1:M5000").SpecialCells(xlCellTypeVisible).Copy Sheets("View").Range("A3")
    
'Filter Combobox 2

     With Sheets("Download").Range("A1:M5000")
    
        .AutoFilter

        If Sheets("Sheet2").Range("AB1").Value <> "" Then
            .AutoFilter Field:=1, Criteria1:=Sheets("Sheet2").Range("AB1").Value
        Else
            .AutoFilter Field:=1
        End If
    
'find first empty row in database
    Dim ws As Worksheet
    Set ws = Worksheets("View")
    Dim iRow As Long
    iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    
'Copy and Paste Filter 2
        If Sheets("Sheet2").Range("AB1").Value = "" Then GoTo Ending
        .Range("A2:M5000").SpecialCells(xlCellTypeVisible).Copy Sheets("View").Cells(iRow, "A")
    End With


    'Filter combobox 3

        With Sheets("Download").Range("A1:M5000")
   
        .AutoFilter

        If Sheets("Sheet2").Range("AC1").Value <> "" Then
            .AutoFilter Field:=1, Criteria1:=Sheets("Sheet2").Range("AC1").Value
        Else
                .AutoFilter Field:=1
        End If
        
    'find first empty row in database
    'Dim ws As Worksheet
    'Set ws = Worksheets("View")
    'Dim iRow As Long
    iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    
'Copy and Paste Filter 3
         If Sheets("Sheet2").Range("AC1").Value = "" Then GoTo Ending
     
        .Range("A2:M5000").SpecialCells(xlCellTypeVisible).Copy Sheets("View").Cells(iRow, "A")
    End With

Ending:
Sheets("View").Select
Range("A3:M3").Select
    With Selection.Interior
        .ColorIndex = 2
        .Pattern = xlSolid
    End With
 
Upvote 0
You must log in or register to reply here.

Similar threads

V
  • Solved
need code help or correction
4 5 6
Replies
51
Views
1K
Alex Blakenburg
A
S
  • Question
VBA script: How to filter on 2 criteria, paste to new worksheet and email? unsolved
Replies
2
Views
469
strangejosh
S
B
  • Solved
Faster way to copy paste filtered data
2
Replies
10
Views
518
Alex Blakenburg
A
S
  • Question
VBA code help please
Replies
3
Views
298
Fluff
Fluff
M
  • Question
ActiveX Switching From One Sub to Another
Replies
0
Views
149
MIdathUK72
M

Forum statistics

Threads
1,191,232
Messages
5,985,425
Members
439,964
Latest member
nparrillo

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
Top