Select Visible Cells Only

I have a workbook like so to collect daily notices to mariners using Excel 16 in Office 365 using windows 10.

wsheet3.jpg

The Information in NQ worksheet changes daily. I use column G to separate into separate worksheets based on regions. (These separate worksheets are then converted in kmz files for google maps).

I created a VB Macro to copy and paste based on column G.

The problem with this macro is caused by the copy and paste macro copies by row number. Obviously when the row number changes to macro won't work.

Selection.ClearContents
Range("G282").Select
ActiveWindow.SmallScroll Down:=-30
ActiveWindow.ScrollRow = 241
ActiveWindow.ScrollRow = 239
ActiveWindow.ScrollRow = 237
ActiveWindow.ScrollRow = 235
ActiveWindow.ScrollRow = 232
ActiveWindow.ScrollRow = 229
ActiveWindow.ScrollRow = 225

I have tried Select Visible (ALT + to copy only visible cells but EXCEL freezes on all my PCs.

Is there any way to create a routine that selects and copies based on data in a column so that if the data changes the row number the macro will still work.

Any help appreciated.

(The file is currently too large to insert.)

Thank you

Bob

Looks like you are already filtering the data. I normally make a unique array and then iterate it using autofilter for that field. If you have already done that, then use SpecialCells. e.g.

Please Login or Register  to view this content.

Thank you for your time Kenneth.

You are correct. I am filtering the data and then copying and pasting the cells into a new worksheet. I was trying to avoid repetitively saving each worksheet individually.

Here is the complete Macro. Which is obviously not working. As the data changes so to does the cell references.

How would you alter it to make unique arrays?

Sub Produce_NQ_xls_files()
'
' Produce_NQ_xls_files Macro
'

'
Sheets("Abbot Pt").Select
ActiveWindow.SmallScroll Down:=-42
Rows("2:89").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-135
Range("A2").Select
Sheets("NQ").Select
ActiveWindow.SmallScroll Down:=-27
ActiveSheet.ListObjects("Table1_2679").Range.AutoFilter Field:=11, Criteria1 _
:="Abbot Point"
Rows("33:202").Select
Selection.Copy
Sheets("Abbot Pt").Select
ActiveWindow.SmallScroll Down:=-18
ActiveSheet.Paste
Range("A2:O2").Select
Sheets("Abbot Pt").Select
Application.CutCopyMode = False
Sheets("Abbot Pt").Copy
ActiveWorkbook.SaveAs Filename:= _
"https://d.docs.live.net/2563cc1bcf48a8f3/Documents/NTM/KML/Working_Files/KML_Qld/KML_Abbot_Pt.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Sheets("Bowen").Select
ActiveWindow.SmallScroll Down:=-21
Rows("2:155").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-165
Range("A2").Select
Sheets("NQ").Select
ActiveWindow.SmallScroll Down:=-162
ActiveSheet.ListObjects("Table1_2679").Range.AutoFilter Field:=11
Range("J15").Select
ActiveWindow.SmallScroll Down:=-21
ActiveSheet.ListObjects("Table1_2679").Range.AutoFilter Field:=1
ActiveSheet.ListObjects("Table1_2679").Range.AutoFilter Field:=11, Criteria1 _
:="Bowen"
Rows("68:96").Select
ActiveWindow.SmallScroll Down:=-27
Selection.Copy
Sheets("Bowen").Select
ActiveSheet.Paste
Sheets("Bowen").Select
Application.CutCopyMode = False
Sheets("Bowen").Copy
ActiveWorkbook.SaveAs Filename:= _
"https://d.docs.live.net/2563cc1bcf48a8f3/Documents/NTM/KML/Working_Files/KML_Qld/KML_Bowen.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Sheets("Townsville").Select
ActiveWindow.SmallScroll Down:=-96
Rows("2:292").Select
Selection.ClearContents
Range("G282").Select
ActiveWindow.SmallScroll Down:=-30
ActiveWindow.ScrollRow = 241
ActiveWindow.ScrollRow = 239
ActiveWindow.ScrollRow = 237
ActiveWindow.ScrollRow = 235
ActiveWindow.ScrollRow = 232
ActiveWindow.ScrollRow = 229
ActiveWindow.ScrollRow = 225
ActiveWindow.ScrollRow = 216
ActiveWindow.ScrollRow = 212
ActiveWindow.ScrollRow = 207
ActiveWindow.ScrollRow = 201
ActiveWindow.ScrollRow = 194
ActiveWindow.ScrollRow = 187
ActiveWindow.ScrollRow = 181
ActiveWindow.ScrollRow = 175
ActiveWindow.ScrollRow = 165
ActiveWindow.ScrollRow = 159
ActiveWindow.ScrollRow = 154
ActiveWindow.ScrollRow = 139
ActiveWindow.ScrollRow = 134
ActiveWindow.ScrollRow = 106
ActiveWindow.ScrollRow = 102
ActiveWindow.ScrollRow = 99
ActiveWindow.ScrollRow = 96
ActiveWindow.ScrollRow = 90
ActiveWindow.ScrollRow = 82
ActiveWindow.ScrollRow = 80
ActiveWindow.ScrollRow = 73
ActiveWindow.ScrollRow = 71
ActiveWindow.ScrollRow = 68
ActiveWindow.ScrollRow = 66
ActiveWindow.ScrollRow = 64
ActiveWindow.ScrollRow = 61
ActiveWindow.ScrollRow = 59
ActiveWindow.ScrollRow = 57
ActiveWindow.ScrollRow = 55
ActiveWindow.ScrollRow = 53
ActiveWindow.ScrollRow = 50
ActiveWindow.ScrollRow = 48
ActiveWindow.ScrollRow = 47
ActiveWindow.ScrollRow = 39
ActiveWindow.ScrollRow = 37
ActiveWindow.ScrollRow = 36
ActiveWindow.ScrollRow = 35
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 32
ActiveWindow.ScrollRow = 31
ActiveWindow.ScrollRow = 30
ActiveWindow.ScrollRow = 28
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 26
ActiveWindow.ScrollRow = 25
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 22
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 2
Sheets("NQ").Select
ActiveWindow.SmallScroll Down:=-24
ActiveSheet.ListObjects("Table1_2679").Range.AutoFilter Field:=11, Criteria1 _
:="Townsville"
Rows("2:203").Select
Selection.Copy
Sheets("Townsville").Select
ActiveWindow.SmallScroll Down:=-24
Range("A2").Select
ActiveSheet.Paste
Sheets("Townsville").Select
Application.CutCopyMode = False
Sheets("Townsville").Copy
Range("A2").Select
ActiveWorkbook.SaveAs Filename:= _
"https://d.docs.live.net/2563cc1bcf48a8f3/Documents/NTM/KML/Working_Files/KML_Qld/KML_Townsville.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Range("G17").Select
ActiveWorkbook.Save
Sheets("NQ").Select
ActiveWindow.SmallScroll Down:=-87
ActiveWindow.ScrollRow = 94
ActiveWindow.ScrollRow = 93
ActiveWindow.ScrollRow = 92
ActiveWindow.ScrollRow = 91
ActiveWindow.ScrollRow = 90
ActiveWindow.ScrollRow = 89
ActiveWindow.ScrollRow = 88
ActiveWindow.ScrollRow = 86
ActiveWindow.ScrollRow = 85
ActiveWindow.ScrollRow = 84
ActiveWindow.ScrollRow = 76
ActiveWindow.ScrollRow = 75
ActiveWindow.ScrollRow = 67
ActiveWindow.ScrollRow = 65
ActiveWindow.ScrollRow = 63
ActiveWindow.ScrollRow = 61
ActiveWindow.ScrollRow = 58
ActiveWindow.ScrollRow = 57
ActiveWindow.ScrollRow = 56
ActiveWindow.ScrollRow = 54
ActiveWindow.ScrollRow = 53
ActiveWindow.ScrollRow = 49
ActiveWindow.ScrollRow = 48
ActiveWindow.ScrollRow = 47
ActiveWindow.ScrollRow = 41
ActiveWindow.ScrollRow = 40
ActiveWindow.ScrollRow = 38
ActiveWindow.ScrollRow = 37
ActiveWindow.ScrollRow = 36
ActiveWindow.ScrollRow = 32
ActiveWindow.ScrollRow = 31
ActiveWindow.ScrollRow = 30
ActiveWindow.ScrollRow = 29
ActiveWindow.ScrollRow = 28
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 26
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 2
Range("D6").Select
ActiveWindow.SmallScroll Down:=-21
ActiveWorkbook.Save
End Sub

I could probably help more using an attached short and simple obfuscated file. You can attach a file by clicking the Go Advanced button in lower right of a reply. Then click the paperclip icon in the menu or the Manage Attachments hyperlink below the reply box. If you do that, state your goals if want a more targeted solution.

When pasting code, please paste between code tags. Insert them by clicking the # icon in the toolbar.

I see you are using the macro recorder. That is fine to learn some syntax. As you learn more, you will learn that Select is seldom needed. ScrollRow is seldom used as well. e.g.

Please Login or Register  to view this content.

Once a columnar range is set, you can use this routine to get uniques.

Please Login or Register  to view this content.

If you need to sort a one dimensional array, this routine can be used. It is a little more advanced than some others since it lets you sort by numbers or strings first when there are both in the array. You probably won't need to sort your uniques but if you do, this can help. e.g. You might want your sheet's names (unique values in column G) to be inserted to be in a sort order.

Please Login or Register  to view this content.