Inserting a Visible Autofiltered Row into Another Sheet (Excluding Header)

dreen

dreen

Board Regular
Joined
Nov 20, 2019
Messages
52
I am trying to AutoFilter (in column A of SHEET 1) the Active Cell in SHEET 2. Then I have an IF Statement that counts the number of Visible Rows, and if it is more than 1 (to exclude the header) then I would like to insert a new row into SHEET 3 and cut and paste the values of the Auto filtered Row in SHEET 1 into the new row in SHEET 3.

Then I clear the Auto Filter in SHEET 1, and insert a new row into SHEET 1 and cut and paste the values of the Active Cell's Row from SHEET 2 into the new row in SHEET 1. IF there are no results from the Auto Filter in SHEET 1, then the ELSE STATEMENT clears the Auto Filter in SHEET 1, inserts a new row into SHEET 1 and cut and pastes the values of the Active Cell's Row from SHEET 2 into the new row in SHEET 1.

Currently, I can't seem to get my code to work if the Auto Filter results in SHEET 2 are in any rows > Row 2. Here is my current code, I have commented to help with navigation:

VBA Code: 
Sub Autofilter_Macro()

Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet

Set sh1 = Sheet1
Set sh2 = Sheet2
Set sh3 = Sheet3

Dim rng As Range
Dim AC As Integer
AC = ActiveCell.Row

sh1.AutoFilterMode = False 'Clears any AutoFilters from Sheet1

sh1.Range("A:A").AutoFilter Field:=1, Criteria1:=ActiveCell.Value 'AutoFilters SHEET 1 column "A" based off the ActiveCell Row in SHEET 2

Set rng = sh1.UsedRange.SpecialCells(xlCellTypeVisible) 'Sets rng to visible cells

    If (rng.Rows.Count > 1) Then 'Counts the # of visible rows

        sh3.Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'Inserts an empty row (with the same format as the one below it) into row 2 of SHEET 3

        sh3.Range("A2:CK2").Value = rng.Offset(rowOffSet:=1).Value 'Sets the new empty row's values in SHEET 3 = the values of the Autofiltered row in SHEET 1

        sh1.ShowallData 'Clears any Autofilters from SHEET 1

        sh1.Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'Inserts an empty row (with the same format as the one below it) into row 2 of SHEET 1

        sh1.Range("A2:CK2").Value = sh2.Range(Cells(AC, 1), Cells(AC, 89)).Value 'Sets the new empty row's values in SHEET 1 = the values of the ActiveCell row in SHEET 2

        MsgBox "Replaced Main Database" 'MsgBox indicating what has executed

    Else

        sh1.Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'Inserts an empty row (with the same format as the one below it) into row 2 of SHEET 1

        sh1.Range("A2:CK2").Value = sh2.Range(Cells(AC, 1), Cells(AC, 89)).Value 'Sets the new empty row's values in SHEET 1 = the values of the ActiveCell row in SHEET 2
         MsgBox "New Entry into Main Database"

    End If

sh1.ShowallData 'Clears any Auotfilters from SHEET 1

End Sub

I am cross referencing my post on another Forum as well:
stackoverflow.com

How to Insert a Visible Autofiltered Row into Another Sheet (Excluding Header)

I am trying to AutoFilter (in column A of SHEET 1) the Active Cell in SHEET 2. Then I have an IF Statement that counts the number of Visible Rows, and if it is more than 1 (to exclude the header) t...
stackoverflow.com stackoverflow.com
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Sort by date Sort by votes
You are not getting an accurate count of visible rows with the code you have. It will always return 1 because that is what the SpecialCellsVisible returns. But if you only use one column for your rng variable and count it, then it gives the correct number of rows.

Code: 
Set rng = Intersect(sh1.Columns(1), sh1.UsedRange.SpecialCells(xlCellTypeVisible)) 'Sets rng to visible cells

    If (rng.Count > 1) Then 'Counts the # of visible rows

Since your rng.Count will give you the number of rows, you can then use Resize with your Insert statement to insert the total number of rows you want to copy.
Code: 
sh3.Rows("2:2").Resize(rng.Count).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'Inserts an empty row (with the same format as the one below it) into row 2 of SHEET 3
that should then accomodate the entire visible range, but now you have to
Code: 
rng.EntireRow.Copy
 
Last edited:
Upvote 0
ChangeThis:
Code: 
sh3.Range("A2:CK2").Value = rng.Offset(rowOffSet:=1).Value 'Sets the new empty row's values in SHEET 3 = the values of the Autofiltered row in SHEET 1
To this:
Code: 
rng.Offset(1).Resize((, UsedRange.Colums.Count).Copy sh3.Range("A2")
Instead of the rng.EntireRow.Copy.
 
Upvote 0
JLGWhiz said:
ChangeThis:
Code: 
sh3.Range("A2:CK2").Value = rng.Offset(rowOffSet:=1).Value 'Sets the new empty row's values in SHEET 3 = the values of the Autofiltered row in SHEET 1
To this:
Code: 
rng.Offset(1).Resize((, UsedRange.Colums.Count).Copy sh3.Range("A2")
Instead of the rng.EntireRow.Copy.
Click to expand...

Hello @JLGWhiz , I keep receiving a Syntax error with
VBA Code: 
rng.Offset(1).Resize((, UsedRange.Colums.Count).Copy sh3.Range("A2")
 
Upvote 0
Let's do it slightly different. First declare a variable, then intitiate it, then use it for the resize.
Code: 
Dim colcnt As Long
colcnt = sh1.UsedRange.Columns.Count
rng.Offset(1).Resize(, colcnt).Copy sh3.Range("A2")
 
Upvote 0
JLGWhiz said:
Let's do it slightly different. First declare a variable, then intitiate it, then use it for the resize.
Code: 
Dim colcnt As Long
colcnt = sh1.UsedRange.Columns.Count
rng.Offset(1).Resize(, colcnt).Copy sh3.Range("A2")
Click to expand...

I have commented out the lines of Code that I have replaced based on your suggestions, and the code seems to be inserting two blank rows into "Sheet 3 (sh3)" and gives me a Run-Time Error '1004' (
Application-defined or object-defined error) on the line
Code: 
rng.Offset(1).Resize(, colcnt).Copy sh3.Range("A2")


The following is the code that I have so far based off your suggestions:

Code: 
[CODE=vba]
Sub Autofilter()

Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet

Set sh1 = Sheet1
Set sh2 = Sheet2
Set sh3 = Sheet3

Dim rng As Range
Dim AC As Integer
AC = ActiveCell.Row

'Added from MrExcel Forum
Dim colcnt As Long
colcnt = sh1.UsedRange.Columns.Count

sh1.AutoFilterMode = False 'Clears any AutoFilters from Sheet1

sh1.Range("A:A").Autofilter Field:=1, Criteria1:=ActiveCell.Value 'AutoFilters SHEET 1 column "A" based off the ActiveCell Row in SHEET 2

'Set rng = Intersect(sh1.Columns(1), sh1.UsedRange.SpecialCells(xlCellTypeVisible)) 'Sets rng to visible cells
Set rng = Intersect(sh1.Columns(1), sh1.UsedRange.SpecialCells(xlCellTypeVisible)) 'Sets rng to visible cells

'    If (rng.Count > 1) Then 'Counts the # of visible rows
    If (rng.Count > 1) Then 'Counts the # of visible rows
 
'        sh3.Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'Inserts an empty row (with the same format as the one below it) into row 2 of SHEET 3
        sh3.Rows("2:2").Resize(rng.Count).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'Inserts an empty row (with the same format as the one below it) into row 2 of SHEET 3

'        sh3.Range("A2:CK2").Value = rng.Offset(rowOffSet:=1).Value 'Sets the new empty row's values in SHEET 3 = the values of the Autofiltered row in SHEET 1
        rng.Offset(1).Resize(, colcnt).Copy sh3.Range("A2")

        sh1.ShowallData 'Clears any Autofilters from SHEET 1

        sh1.Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'Inserts an empty row (with the same format as the one below it) into row 2 of SHEET 1

        sh1.Range("A2:CK2").Value = sh2.Range(Cells(AC, 1), Cells(AC, 89)).Value 'Sets the new empty row's values in SHEET 1 = the values of the ActiveCell row in SHEET 2

        MsgBox "Replaced Main Database" 'MsgBox indicating what has executed

    Else

        sh1.Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'Inserts an empty row (with the same format as the one below it) into row 2 of SHEET 1

        sh1.Range("A2:CK2").Value = sh2.Range(Cells(AC, 1), Cells(AC, 89)).Value 'Sets the new empty row's values in SHEET 1 = the values of the ActiveCell row in SHEET 2
         MsgBox "New Entry into Main Database"

    End If

sh1.ShowallData 'Clears any Auotfilters from SHEET 1

End Sub
 
Upvote 0
I think I havethe bugs worked out, but you need to test it to be sure.
Code: 
Sub Autofilter()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
Set sh3 = Sheets("Sheet3")
Dim rng As Range, rng2 As Range
Dim AC As Long
AC = ActiveCell.Row
'Added from MrExcel Forum
Dim colcnt As Long
colcnt = sh1.UsedRange.Columns.Count
sh1.AutoFilterMode = False 'Clears any AutoFilters from Sheet1
sh1.Range("A:A").Autofilter Field:=1, Criteria1:=ActiveCell.Value 'AutoFilters SHEET 1 column "A" based off the ActiveCell Row in SHEET 2
'Set rng = Intersect(sh1.Columns(1), sh1.UsedRange.SpecialCells(xlCellTypeVisible)) 'Sets rng to visible cells
Set rng = Intersect(sh1.Columns(1), sh1.UsedRange.Offset(1)).SpecialCells(xlCellTypeVisible) 'Sets rng to visible cells
    
    If (rng.Count > 1) Then 'Counts the # of visible rows
'        sh3.Rows(2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'Inserts an empty row (with the same format as the one below it) into row 2 of SHEET 3
        sh3.Rows(2).Resize(rng.Count).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'Inserts an empty row (with the same format as the one below it) into row 2 of SHEET 3
'        sh3.Range("A2:CK2").Value = rng.Offset(rowOffSet:=1).Value 'Sets the new empty row's values in SHEET 3 = the values of the Autofiltered row in SHEET 1
       Set rng2 = sh1.UsedRange.Offset(1).SpecialCells(xlCellTypeVisible)
        rng2.Copy sh3.Range("A2")
        sh1.ShowAllData 'Clears any Autofilters from SHEET 1
        sh1.Rows(2).Insert CopyOrigin:=xlFormatFromRightOrBelow 'Inserts empty rows (with the same format as the one below it) into row 2 of SHEET 1
        sh1.Range("A2:CK2") = sh2.Range(sh2.Cells(AC, 1), sh2.Cells(AC, 89)).Value  'Sets the new empty row's values in SHEET 1 = the values of the ActiveCell row in SHEET 2
        MsgBox "Replaced Main Database" 'MsgBox indicating what has executed
    Else
        sh1.Rows(2).Insert CopyOrigin:=xlFormatFromRightOrBelow 'Inserts an empty row (with the same format as the one below it) into row 2 of SHEET 1
        sh1.Range("A2:CK2") = sh2.Range(sh2.Cells(AC, 1), sh2.Cells(AC, 89)).Value 'Sets the new empty row's values in SHEET 1 = the values of the ActiveCell row in SHEET 2
         MsgBox "New Entry into Main Database"
    End If
sh1.AutoFilterMode = False 'Clears any Auotfilters from SHEET 1
End Sub
 
Upvote 0
JLGWhiz said:
I think I havethe bugs worked out, but you need to test it to be sure.
Code: 
Sub Autofilter()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
Set sh3 = Sheets("Sheet3")
Dim rng As Range, rng2 As Range
Dim AC As Long
AC = ActiveCell.Row
'Added from MrExcel Forum
Dim colcnt As Long
colcnt = sh1.UsedRange.Columns.Count
sh1.AutoFilterMode = False 'Clears any AutoFilters from Sheet1
sh1.Range("A:A").Autofilter Field:=1, Criteria1:=ActiveCell.Value 'AutoFilters SHEET 1 column "A" based off the ActiveCell Row in SHEET 2
'Set rng = Intersect(sh1.Columns(1), sh1.UsedRange.SpecialCells(xlCellTypeVisible)) 'Sets rng to visible cells
Set rng = Intersect(sh1.Columns(1), sh1.UsedRange.Offset(1)).SpecialCells(xlCellTypeVisible) 'Sets rng to visible cells
   
    If (rng.Count > 1) Then 'Counts the # of visible rows
'        sh3.Rows(2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'Inserts an empty row (with the same format as the one below it) into row 2 of SHEET 3
        sh3.Rows(2).Resize(rng.Count).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow 'Inserts an empty row (with the same format as the one below it) into row 2 of SHEET 3
'        sh3.Range("A2:CK2").Value = rng.Offset(rowOffSet:=1).Value 'Sets the new empty row's values in SHEET 3 = the values of the Autofiltered row in SHEET 1
       Set rng2 = sh1.UsedRange.Offset(1).SpecialCells(xlCellTypeVisible)
        rng2.Copy sh3.Range("A2")
        sh1.ShowAllData 'Clears any Autofilters from SHEET 1
        sh1.Rows(2).Insert CopyOrigin:=xlFormatFromRightOrBelow 'Inserts empty rows (with the same format as the one below it) into row 2 of SHEET 1
        sh1.Range("A2:CK2") = sh2.Range(sh2.Cells(AC, 1), sh2.Cells(AC, 89)).Value  'Sets the new empty row's values in SHEET 1 = the values of the ActiveCell row in SHEET 2
        MsgBox "Replaced Main Database" 'MsgBox indicating what has executed
    Else
        sh1.Rows(2).Insert CopyOrigin:=xlFormatFromRightOrBelow 'Inserts an empty row (with the same format as the one below it) into row 2 of SHEET 1
        sh1.Range("A2:CK2") = sh2.Range(sh2.Cells(AC, 1), sh2.Cells(AC, 89)).Value 'Sets the new empty row's values in SHEET 1 = the values of the ActiveCell row in SHEET 2
         MsgBox "New Entry into Main Database"
    End If
sh1.AutoFilterMode = False 'Clears any Auotfilters from SHEET 1
End Sub
Click to expand...

Thank you for your help!
 
Upvote 0
@dreen
In future please supply links to ALL sites where you have asked a question, not just one of them.
Thanks
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question
Data not copying fully into ListBox2
Replies
0
Views
114
Patriot2879
P
S
  • Solved
Paste the data in row 10
Replies
2
Views
239
sofas
S
S
  • Question
Copy a column value when the values match to multiple sheets of the workbook
Replies
1
Views
234
sofas
S
M
  • Solved
VBA entry in last row
Replies
5
Views
291
Mohsin110
M
B
  • Question
VBA code to cut and paste multiple filtered rows based on multiple criteria
Replies
2
Views
496
Alex Blakenburg
A

Forum statistics

Threads
1,214,981
Messages
6,122,566
Members
449,089
Latest member
Motoracer88

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