Solved: Using Resize to copy and paste?

[Simon Lloyd]

Hi all, i am trying to copy some filtered data and paste to another sheet but i cant seem to get resize to work properly, i have to admit i don't really understand RESIZE properly, here's what i am trying.
[VBA]
With ActiveSheet.Range("A:A")
.AutoFilter Field:=1, Criteria1:="Test"
.Offset(1, 0).Resize(.Rows.Count - 1, _
.Columns.Count).Copy Destination:=Worksheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0)
End With
[/VBA]Any ideas?

[Bob Phillips]

I can't see what you are trying to resize into, so a few general comments.

Resize is used to increase the size of a range by some variable factor. You can increase the number of rows, and/or the number of columns. Whenever you resize, you have to be aware of the base position, so that you don't try to increase by more rows or columns than are available (you seem to have hit that problem AFAICS).

It should also be used to increase by as little as possible, it is an efficiency aid IMO.

And finally, nothing to do with resize, but you set the object base of ActiveSheet.Range("A:A") with your With statement, but you then do a .Rows.Count. This does work here because you used the whole column, but you need to be careful, in case at either times you select part of the range.

[Simon Lloyd]

Bob, you know me by now, its a small snippet of something larger i am trying to do, i am creating a worksheet with unique names from a list then from those names creating new worksheets, then back to the original sheet to filter by worksheet name, copy the filtered data and paste to the next available row in the corresponding worksheet...everything else works except it wont copy using resize!

take a look.

[Bob Phillips]

Simon,

I don't think you even need Resize here. I am also confused as to why you get range address strings rather than actual ranges

[vba]

Sub Sheets_By_Brand()
Dim rRange As Range, rCell As Range
Dim wSheet As Worksheet
Dim wSheetStart As Worksheet
Dim strText As String
Dim MyCell As Range, rng As Range
Dim rng3 As String, Rng1 As String
Dim rng2 As Range

Set wSheetStart = ActiveSheet
wSheetStart.AutoFilterMode = False
Set rRange = Range("A2", Range("A65536").End(xlUp))

On Error Resume Next
Application.DisplayAlerts = False
Worksheets("UniqueList").Delete
Worksheets.Add().Name = "UniqueList"

With Worksheets("UniqueList")

rRange.AdvancedFilter xlFilterCopy, rRange, _
Worksheets("UniqueList").Range("A1"), True
Set rRange = .Range("A2", .Range("A65536").End(xlUp))
End With
On Error Resume Next

With wSheetStart

For Each rCell In rRange

strText = rCell
.Range("A1").AutoFilter 1, strText
Worksheets(strText).Delete
Worksheets.Add().Name = strText
Next rCell
End With

With wSheetStart
.AutoFilterMode = False
.Activate
End With

On Error GoTo Nxt

With Sheets("UniqueList")

Rng1 = .Range("A2", .Range("A65536").End(xlUp)).Address
End With
Set rng = Sheets("UniqueList").Range(Rng1)
For Each MyCell In rng

With wSheetStart

rng3 = .Range("A1", .Range("A65536").End(xlUp)).Address
End With

With wSheetStart.Range(rng3)

.AutoFilter Field:=1, Criteria1:=MyCell
.SpecialCells(xlCellTypeVisible).EntireRow.Copy _
Destination:=Worksheets(MyCell.Value).Range("A1")
End With

If MyCell = "" Then GoTo Nxt
wSheetStart.AutoFilterMode = False
Next MyCell
Nxt:
wSheetStart.AutoFilterMode = False
Sheets("UniqueList").Delete
Application.DisplayAlerts = True

End Sub
[/vba]

[Bob Phillips]

Oh, and you wern't dot qualifyng the ranges again.

[Simon Lloyd]

Bob, many thanks, i have had lots of code in and out, you will notice that i have even Dim'd ranges that arent there!, as for the Rng etc as addresses it was a quick fix rather than plough through it all to sort out my qualifiers...to tell you the truth i was getting a little word blind, i couldn't even see the simple errors i was that close after a while!

I'll consider my hands slapped

[Simon Lloyd]

Also i thought using copy specialcells(xlvisible) would have copied blanks below the filtered range so didnt even try it!

[Simon Lloyd]

One thing about using special cells is i didnt want to copy the header row over, previous i had .Usedrange but of course didnt give the desired results!

[Bob Phillips]

This seems to do what you want

[vba]

Sub Sheets_By_Brand()
Dim wSheetStart As Worksheet
Dim strText As String
Dim rngSource As Range, rngUnique As Range
Dim rngSourceLess As Range

Set wSheetStart = ActiveSheet
wSheetStart.AutoFilterMode = False
Set rngSource = Range("A1", Range("A" & Rows.Count).End(xlUp))
Set rngSourceLess = Range("A2", Range("A" & Rows.Count).End(xlUp))

On Error Resume Next
Application.DisplayAlerts = False
Worksheets("UniqueList").Delete
Worksheets.Add().Name = "UniqueList"

With Worksheets("UniqueList")

rngSource.AdvancedFilter xlFilterCopy, rngSource, .Range("A1"), True
Set rngUnique = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
End With
On Error Resume Next

With wSheetStart

For Each cell In rngUnique

.Range("A1").AutoFilter 1, cell.Value
Worksheets(cell.Value).Delete
Worksheets.Add().Name = cell.Value
Next cell

.AutoFilterMode = False
.Activate
End With
On Error GoTo 0

For Each cell In rngUnique

With wSheetStart


rngSource.AutoFilter Field:=1, Criteria1:=cell.Value
rngSourceLess.SpecialCells(xlCellTypeVisible).EntireRow.Copy _
Destination:=Worksheets(cell.Value).Range("A1")

If cell.Value = "" Then Exit For
.AutoFilterMode = False
End With
Next cell

wSheetStart.AutoFilterMode = False
Sheets("UniqueList").Delete
Application.DisplayAlerts = True

End Sub
[/vba]

[Simon Lloyd]

As usual Bob, brilliant!, i hardly recognise my work , thats a lot smarter and neater. Believe it or not i did try using add item to store then names as a variable and use that but way beyond my capabilities, i'm still a poke n hope kinda guy!

Thanks again.

[Bob Phillips]

In reality it is not that different than your code. I removed all of the rng address strings and used ranges, gave them names that better reflected their purpose IMO, removed a bit of code that you replicated, grouped stuff a bit to remove superfluous withs, and the only real bit I added was have range objects to point at the whole range on the Names sheet and one to start at A2, and use eache where appropriate.

[Simon Lloyd]

Well i added code, removed code, added bits, removed bits (hence the qualifiers going missing!) swapped and changed that much that i was on the verge of deleting the lot and starting again because it had got so messy! A clear head was needed......you always seem to have that, although i don't know how after staying up so late this morning!

[Norie]

Simon

If you look at my post in the thread over on MrExcel you'll see there's no need for Resize or SpecialCells.

Just use advanced filter instead of autofilter.

[Simon Lloyd]

Norie, nice