Pause a macro for user input

[Guest]

I'm trying to create a macro in Excel 2002 which will select certain rows of
a worksheet using the Autofilter capability. The (non-contiguous) rows will
then be copied to another worksheet within the file. The number of rows
selected will range from zero on up. Since the number of rows will be
different each time, and I don't know how to get Excel to deal with that
variability, I want to have the macro pause to let the user select the rows
to be copied, then continue once the selection is made. (Assume the user
will have only minimal skills with Excel.) How do I pause the macro, let the
user can make his/her selections, then resume the macro? I have VERY LIMITED
VBA programming skills.

 

[Don Guillett]

You probably can do this using special cells
Look in the vba help index for SPECIALCELLS

 

[Guest]

You would have to use Application.InputBox with Type:=8.

MyVariable = Application.InputBox("Select Range to Copy.", "Select", Type:=8)
Range(MyVariable).Copy
Destination:=

 

[Bob Phillips]

No need. After autofiltering, just copy the visible rows using specialcells

Set rngToCopy = rngFiltered.SpecialCells(xlCellTypeVisible).EntireRow

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Guest]

Bob, this idea LOOKS like it'll be the answer to a lot of needs, but I can't
make it work. The problem is my EXTREMELY limited programming skills. I
added a Dim statement immediately before this line making rngToCopy an Object
(see code below) but when I run the macro I get an "object required" error
(#424) for your code line. Same thing happens if I designate rngToCopy as a
Range. I sometimes get a tooltip that tells me the value of rngToCopy is
"NOTHING."

Here's the macro code:
Sub EMails2()
'
' EMails2 Macro
' Macro recorded 11/12/2007 by Ross B. Lampert
'

'
Selection.AutoFilter
Selection.AutoFilter Field:=19, Criteria1:="<>"
Dim rngToCopy As Object
Set rngToCopy = rngFiltered.SpecialCells(xlCellTypeVisible).EntireRow
Sheets("E-Mails").Select
Range("A2").Select
ActiveSheet.Paste
End Sub

What am I doing wrong?

Thanks.

 

[Don Guillett]

Untested but try

sub doit()
Selection.AutoFilter Field:=19, Criteria1:="<>"
selection.SpecialCells(xlCellTypeVisible).copy
Sheets("E-Mails").Range("A2")
end sub

 

[Don Guillett]

copy _
or bring up the next line so it is ONE line

 

[Guest]

This suggestion (with later correction) works too well. Instead of copying
only the rows selected by the autofilter, it copies them AND every possible
blank row below them, down to row #65,000+. Then I get a "Paste method of
worksheet class failed" error message.

 

[Dave Peterson]

What was selected when you ran the code?

Try just selecting the range you want filtered--not the entire column.

 

[Guest]

Dave, as the original request for help said, I'm trying to copy a set of
rows, selected via AutoFilter, from one worksheet to another within the same
workbook. Stepping through the latest suggested procedure, watching the
spreadsheet as well as the code, nothing is highlighted as having been
selected to be copied, yet all of the rows selected by the autofilter
criterion, and 65,000+ blank rows below them, do get copied to the target
worksheet. If you review the previous posts to this thread, you'll see what
others have suggested and how well or poorly they've worked. Thanks for your
interest.

 

[Dave Peterson]

I'd use:

with worksheets("somesheetnamehere")
.autofiltermode = false 'turn off any existing autofilter
.range("a1").currentregion.autofilter Field:=19, Criteria1:="<>"
with .autofilter.range
.cells.specialcells(xlcelltypevisible).entirerow.copy _
destination:=Worksheets("E-Mails").Range("A2")
end with
End with

I'm assuming that the range to be filtered is contiguous and starts in A1
(headers in row 1). (That's what .range("A1").currentregion does.)

I think it's a problem with the selection. If just one cell is selected, then
..specialcells will refer to the whole worksheet. If you have multiple cells
selected, then only that original selection will be looked at.

It's not unlike the way Edit|Replace works.

If you select multiple cells first, then the Replace (or Find) will only look at
that selection.

If you have only a single cell selected, then edit|replace or edit|Find will
look at all the cells on the sheet.

By using .autofilter.range, you don't have to worry about what was selected.

 

[Guest]

Can't hurt to try. Thanks!

I'd use:

with worksheets("somesheetnamehere")
.autofiltermode = false 'turn off any existing autofilter
.range("a1").currentregion.autofilter Field:=19, Criteria1:="<>"
with .autofilter.range
.cells.specialcells(xlcelltypevisible).entirerow.copy _
destination:=Worksheets("E-Mails").Range("A2")
end with
End with

I'm assuming that the range to be filtered is contiguous and starts in A1
(headers in row 1). (That's what .range("A1").currentregion does.)

I think it's a problem with the selection. If just one cell is selected, then
..specialcells will refer to the whole worksheet. If you have multiple cells
selected, then only that original selection will be looked at.

It's not unlike the way Edit|Replace works.

If you select multiple cells first, then the Replace (or Find) will only look at
that selection.

If you have only a single cell selected, then edit|replace or edit|Find will
look at all the cells on the sheet.

By using .autofilter.range, you don't have to worry about what was selected.

 

[Guest]

WOO-HOO! 99% success, Dave! Your code works as I need it to for some of the
sorts I'm doing and I've been able to tweak it to mostly work the way I need
it to in others.

The one remaining glitch is this: there are a lot of cases in which I'll
make several (independent) sorts--or better, filters--of data from one
spreadsheet and copy the results to another, stacking each new set of
filtered data below the one(s) pasted onto the spreadsheet before. With the
code below, the first row, containing the column headers (as you correctly
assumed it would), gets copied every time. I need help to figure out some
way to NOT copy the header row every time. I've tried deleting different
pieces of the code below but either get an error message or the row still
gets copied.

I can kludge together some code to delete the excess header row copies but
I'd rather have a clean piece of code I can use repeatedly to get the right
result the first time.

Thanks for your help so far. It's been great.

 

[Dave Peterson]

maybe...

dim RngToCopy as range
with worksheets("somesheetnamehere")
.autofiltermode = false 'turn off any existing autofilter
.range("a1").currentregion.autofilter Field:=19, Criteria1:="<>"
with .autofilter.range
if .columns(1).cells.specialcells(xlcelltypevisible).cells.count = 1 then
'only headers are visible, so skip it
else
'"remove" a row and come down 1 row
set rngtocopy = .resize(.rows.count-1,.columns.count) _
.offset(1,0)
rngtocopy.copy _
destination:=Worksheets("E-Mails").Range("A2")
end with
End with

(Untested, uncompiled. Watch for typos!)

 

[RBLampert]

We're back to the same problem I had earlier, Dave. Whenever I try to use
"dim [anything] as [object or range], [anything] has a value of "Nothing",
which the Set statement doesn't seem to overcome, and (so?) I get an "object
required" run-time error (#424).

Here's the actual code I'm using:

Sub TwoMonthsExpired()
'
' TwoMonthsExpired Macro
' Macro recorded 11/17/2007 by Ross B. Lampert
' This macro selects all members who are listed as "Expired Two Month Ago"
' and copies them from the "Updates" worksheet onto the "Expiring"
worksheet.

Dim rngtocopy As Range
With Worksheets("Updates")
.AutoFilterMode = False 'Turns off any existing autofilter
.Range("A1").CurrentRegion.AutoFilter Field:=16, Criteria1:="EXPIRED TWO
MONTH AGO"
With .AutoFilter.Range
If Columns(1).Cells.SpecialCells(xlCellTypeVisible).Cells.Count = 1
Then
' This skips the case where the AutoFilter produces no rows
Else
' This line is supposed to remove the header row and start the
copy with the first data row
Set rngtocopy = .Resize(.Rows.Count - 1, .Columns.Count.Offset(1))
' Problems above: rngtocopy = Nothing and Run-time error
424--"Object required" here.

' Copies the data rows onto the first blank row of the
"Expiring" tab
rngtocopy.Copy _

Destination:=Worksheets("Expiring").Range("A1").CurrentRegion.End(xlDown).Offset(1)
End If
End With
End With

 

[Tim Williams]

Check this line:

Set rngtocopy = .Resize(.Rows.Count - 1, .Columns.Count.Offset(1))

Does not seem correct. Did you mean:

Set rngtocopy = .Resize(.Rows.Count - 1, .Columns.Count).Offset(1)

?

Tim

We're back to the same problem I had earlier, Dave. Whenever I try to use
"dim [anything] as [object or range], [anything] has a value of "Nothing",
which the Set statement doesn't seem to overcome, and (so?) I get an
"object
required" run-time error (#424).

Here's the actual code I'm using:

Sub TwoMonthsExpired()
'
' TwoMonthsExpired Macro
' Macro recorded 11/17/2007 by Ross B. Lampert
' This macro selects all members who are listed as "Expired Two Month
Ago"
' and copies them from the "Updates" worksheet onto the "Expiring"
worksheet.

Dim rngtocopy As Range
With Worksheets("Updates")
.AutoFilterMode = False 'Turns off any existing autofilter
.Range("A1").CurrentRegion.AutoFilter Field:=16, Criteria1:="EXPIRED
TWO
MONTH AGO"
With .AutoFilter.Range
If Columns(1).Cells.SpecialCells(xlCellTypeVisible).Cells.Count = 1
Then
' This skips the case where the AutoFilter produces no rows
Else
' This line is supposed to remove the header row and start the
copy with the first data row
Set rngtocopy = .Resize(.Rows.Count - 1,
.Columns.Count.Offset(1))
' Problems above: rngtocopy = Nothing and Run-time error
424--"Object required" here.

' Copies the data rows onto the first blank row of the
"Expiring" tab
rngtocopy.Copy _

Destination:=Worksheets("Expiring").Range("A1").CurrentRegion.End(xlDown).Offset(1)
End If
End With
End With

maybe...

dim RngToCopy as range
with worksheets("somesheetnamehere")
.autofiltermode = false 'turn off any existing autofilter
.range("a1").currentregion.autofilter Field:=19, Criteria1:="<>"
with .autofilter.range
if .columns(1).cells.specialcells(xlcelltypevisible).cells.count =
1 then
'only headers are visible, so skip it
else
'"remove" a row and come down 1 row
set rngtocopy = .resize(.rows.count-1,.columns.count) _
.offset(1,0)
rngtocopy.copy _
destination:=Worksheets("E-Mails").Range("A2")
end with
End with

(Untested, uncompiled. Watch for typos!)