Macro always skips row 1 and partner macro only works when new sheet created is sheet1

wittonlin

Board Regular
Joined
Jan 30, 2016
Messages
144
These two macros are always ran together. (the ones together in the first window.)

This one selects all the chosen rows with certain states using column 7 and moves them all to a new sheet1.
MoveNonStatesToSheet1

This, of course, moves the rows back to the same workbook and appends to first empty row.
MoveFromSheet1ToCurrentLeadFileUsingandDelete3


Somewhere between these two macros there's a problem with skipping row 1 in this process. It's no big deal until row 1 has a state like AZ, that I'm trying to move and it gets stuck in row 1 :)

The other issue is unlike the 2nd macro that appears to not necessarily look for just sheet1, I think it just looks for last sheet used and gets the data from there. I need the first macro to do something similar. If when a new sheet is created, and sheet1 was used already during multiple saves, it won't matter. I need it to use whatever the new sheet is 1, 2, 3 probably not greater than that. The 2nd macro shouldn't be affected if it's not sheet1 where the rows it needs to get are at, if I'm reading right. :)

Code:
Sub MoveNonStatesToSheet1()

Sheets.Add after:=Sheets(Sheets.count) ' worksheet creation

Dim r As Range, filtr As Range
With Worksheets("CurrentLeadFileUsing")
Set r = .Range("A1").CurrentRegion

On Error Resume Next
r.AutoFilter field:=.Range("G1").Column, Criteria1:="KY"
Set filtr = r.SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
Set filtr = r.Offset(1, 0).Resize(r.Rows.count - 0).SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
filtr.Copy
With Worksheets("Sheet1")
.Cells(Rows.count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
filtr.EntireRow.Delete
r.AutoFilter

On Error Resume Next
r.AutoFilter field:=.Range("G1").Column, Criteria1:="TN"
Set filtr = r.SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
Set filtr = r.Offset(1, 0).Resize(r.Rows.count - 0).SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
filtr.Copy
With Worksheets("Sheet1")
.Cells(Rows.count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
filtr.EntireRow.Delete
r.AutoFilter

On Error Resume Next
r.AutoFilter field:=.Range("G1").Column, Criteria1:="KS"
Set filtr = r.SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
Set filtr = r.Offset(1, 0).Resize(r.Rows.count - 0).SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
filtr.Copy
With Worksheets("Sheet1")
.Cells(Rows.count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
filtr.EntireRow.Delete
r.AutoFilter

On Error Resume Next
r.AutoFilter field:=.Range("G1").Column, Criteria1:="OK"
Set filtr = r.SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
Set filtr = r.Offset(1, 0).Resize(r.Rows.count - 0).SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
filtr.Copy
With Worksheets("Sheet1")
.Cells(Rows.count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
filtr.EntireRow.Delete
r.AutoFilter

On Error Resume Next
r.AutoFilter field:=.Range("G1").Column, Criteria1:="NE"
Set filtr = r.SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
Set filtr = r.Offset(1, 0).Resize(r.Rows.count - 0).SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
filtr.Copy
With Worksheets("Sheet1")
.Cells(Rows.count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
filtr.EntireRow.Delete
r.AutoFilter

On Error Resume Next
r.AutoFilter field:=.Range("G1").Column, Criteria1:="AK"
Set filtr = r.SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
Set filtr = r.Offset(1, 0).Resize(r.Rows.count - 0).SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
filtr.Copy
With Worksheets("Sheet1")
.Cells(Rows.count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
filtr.EntireRow.Delete
r.AutoFilter

On Error Resume Next
r.AutoFilter field:=.Range("G1").Column, Criteria1:="AL"
Set filtr = r.SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
Set filtr = r.Offset(1, 0).Resize(r.Rows.count - 0).SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
filtr.Copy
With Worksheets("Sheet1")
.Cells(Rows.count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
filtr.EntireRow.Delete
r.AutoFilter

On Error Resume Next
r.AutoFilter field:=.Range("G1").Column, Criteria1:="AZ"
Set filtr = r.SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
Set filtr = r.Offset(1, 0).Resize(r.Rows.count - 0).SpecialCells(xlCellTypeVisible)
'MsgBox filtr.Address
filtr.Copy
With Worksheets("Sheet1")
.Cells(Rows.count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
filtr.EntireRow.Delete
r.AutoFilter

Call SortEntireWorksheetByStateNOSaveAs

End With

End Sub




Sub MoveFromSheet1ToCurrentLeadFileUsingandDelete3()

For j = 2 To Sheets.count ' from sheet 2 to last sheet

Sheets(j).Activate ' make the sheet active

Range("A1").Select

Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select 'select all data

' copy cells selected in the new sheet on last line

Selection.Copy Destination:=Workbooks("CurrentLeadFileUsing.csv").Sheets(1).Range("A65536").End(xlUp)(2)

Application.DisplayAlerts = False
Sheets("Sheet1").Delete

Next

End Sub


This call is to reorder the rows, by state again, that were not moved to the bottom of the file.

Code:
Sub SortEntireWorksheetByStateNOSaveAs()

'use the keyword "Selection" for the currently selected range
Cells.Select
With ActiveSheet.Sort
    .SortFields.Clear
    'the key you want to use is the column to sort on. I used column 1, which is "A", column "B" is 2, etc
    .SortFields.Add Key:=Selection.Columns(7), Order:=xlAscending
    .SetRange Selection
    .Apply
    
End With
    
End Sub


Thank you for anyone able to help!
Mark
 
Last edited:

Some videos you may like

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.

wittonlin

Board Regular
Joined
Jan 30, 2016
Messages
144
I can see the data shift down one row as soon as I run the macro, then the blank row 1 goes away. No matter what I can't get it to include row 1 in the process!

This seems right, at least starting at cell A1!
Set r = .Range("A1").CurrentRegion

This line I'm sure has to do with sheet1 where the data is going.
.Cells(Rows.count, "A").End(xlUp).Offset(1, 0).PasteSpecial

That leaves this line and I've tried every combination I can think of!
Set filtr = r.Offset(1, 0).Resize(r.Rows.count - 0).SpecialCells(xlCellTypeVisible)
 
Last edited:

wittonlin

Board Regular
Joined
Jan 30, 2016
Messages
144
this place sure isn't like it used to be. This has always been one of the best boards on the net
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
13,870
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
That leaves this line and I've tried every combination I can think of!
Set filtr = r.Offset(1, 0).Resize(r.Rows.count - 0).SpecialCells(xlCellTypeVisible)

The Offset(1,0) moves the whole range down 1 row.
The Resize(r.Rows.count - 1) in the original code removes the last row from the range after the move down so the last row in the range is still the same, so if you just want the whole range it is just...
Code:
Set filtr = r.SpecialCells(xlCellTypeVisible)

The reason you move it down when using autofilter is to remove the header (which you should always have) when copying using autofilter.
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,122,912
Messages
5,598,833
Members
414,260
Latest member
joishe

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