In the code below I have an Array setup (or so I think), How do I use it to
delete the rows that have been copied?
What I have fails with Error 9, subscript out of range.

'======
Sub test1()
sUserPart = InputBox(("Enter a Value!"), Default:="8769")
With Sheets("Sheet1")
Sh1LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
Sh1LastRow = Sh1LastRow + 1
Set Sh1Range = .Range("B1:B" & Sh1LastRow)
End With
sFound = False
For Each sh1cell In Sh1Range
If sh1cell.Value Like "*" & sUserPart & "*" Then
sFound = True
Application.Goto
Reference:=Worksheets("Sheet1").Range(sh1cell.Addr ess), _
Scroll:=True
vSelection = MsgBox("Use this selection? " & sh1cell.Value & "
", vbYesNoCancel)
If vSelection = vbYes Then
sFound = True
With Sheets("Sheet2")
sh2lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
Set Sh2Range = .Range("A1:A" & sh2lastrow)
If Sheets("Sheet2").Range("A" & sh2lastrow).Value < ""
Then
sh2lastrow = sh2lastrow + 1
End If
End With
sh1cell.EntireRow.Copy
Destination:=Sheets("Sheet2").Range("A" & sh2lastrow)
Dim N As Long
Dim CellArray() As Variant
N = N + 1
ReDim Preserve CellArray(1 To N)
CellArray(N) = sh1cell.Address
End If
ElseIf vSelection = vbNo Then
sFound = False
ElseIf vSelection = vbCancel Then
sFound = False
GoTo EndIt
End If
Next sh1cell
If sFound = False Then
MsgBox "No Match Found!"
End If
If N 0 Then
Sheets(CellArray()).EntireRow.Delete 'reports error 9
Selection.Delete
End If
EndIt:
Range("A1").Activate
End Sub
'======
--
Regards

VBA.Newb.Confused
XP Pro
Office 2007

Rick S. wrote:
In the code below I have an Array setup (or so I think), How do I use it to
delete the rows that have been copied?
What I have fails with Error 9, subscript out of range.


Your line Sheets(CellArray()).EntireRow.Delete doesn't make any sense.
If CellArray() is a Variant() array, Sheets(CellArray()) is nonsense.

And what is the point of your line Application GoTo . . .???

Alan Beban

Hence my request for help?
This code was provided by other members and I am attempting to learn from
it. It is used in another module and functions properly, in this module I am
trying to use it to delete rows after the user makes selections. I have
found that deleting rows during selection throws off the counting during
selection and will omit rows from deletion.

The originating array code is as below, creating an array of selected sheets.
'======
Sub CopySelectSheets()

Dim N As Long
Dim ShtArray() As Variant
Dim Wks As Worksheet

For Each Wks In Worksheets
If Wks.Name < "ListA" Then
If Wks.Cells(4, "D").Value = 10 Then
N = N + 1
ReDim Preserve ShtArray(1 to N)
ShtArray(N) = Wks.Name
End If
End If
Next Wks

If N 0 Then
Sheets(ShtArray()).Copy After:=Sheets(ShtArray(N))
End If

End Sub
'======

The "goto" code scrolls to the cell that has a match.
'======
Application.Goto Reference:=Worksheets("Sheet1").Range(sh1cell.Addr ess), _
Scroll:=True
'======
Above is one string.
--
Regards

VBA.Newb.Confused
XP Pro
Office 2007

I'm confused at what you're doing, but if you want to delete rows, it's usually
easier to start at the bottom and work your way to the top:

Dim iRow as long
dim FirstRow as long
dim LastRow as long

with worksheets("somesheetnamehere")
firstrow = 2 'headers could be in row 1
lastrow = .cells(.rows.count,"B").end(xlup).row
for irow = lastrow to firstrow step -1
if lcase(.cells(irow,"B").value) = lcase("delete me") then
.rows(irow).delete
end if
next irow
end with

==========
A different option is to start from the top and work down, but build a range
(not an array) that can be deleted later. This method could fail if the range
has a lot of cells and there's lots of gaps in it.

dim myCell as range
dim myRng as range
dim DelRng as range

with worksheets("somesheetnamehere")
set myrng = .range("B2",.cells(.rows.count,"B").end(xlup))
end with

for each mycell in myrng.cells
if lcase(mycell.value) = lcase("delete me") then
if delrng is nothing then
'prime the pump
set delrng = mycell
else
'add more to the delrng
set delrng = union(mycell,delrng)
end if
end if
next mycell

if delrng is nothing then
'nothing found to delete
else
delrng.entirerow.delete
end if

=====
Both are uncompiled and untested--watch for typos.

Rick S. wrote:

Hence my request for help?
This code was provided by other members and I am attempting to learn from
it. It is used in another module and functions properly, in this module I am
trying to use it to delete rows after the user makes selections. I have
found that deleting rows during selection throws off the counting during
selection and will omit rows from deletion.

The originating array code is as below, creating an array of selected sheets.
'======
Sub CopySelectSheets()

Dim N As Long
Dim ShtArray() As Variant
Dim Wks As Worksheet

For Each Wks In Worksheets
If Wks.Name < "ListA" Then
If Wks.Cells(4, "D").Value = 10 Then
N = N + 1
ReDim Preserve ShtArray(1 to N)
ShtArray(N) = Wks.Name
End If
End If
Next Wks

If N 0 Then
Sheets(ShtArray()).Copy After:=Sheets(ShtArray(N))
End If

End Sub
'======

The "goto" code scrolls to the cell that has a match.
'======
Application.Goto Reference:=Worksheets("Sheet1").Range(sh1cell.Addr ess), _
Scroll:=True
'======
Above is one string.
--
Regards

VBA.Newb.Confused
XP Pro
Office 2007

--

Dave Peterson

The "attempt" is to find a value in a row and if found copy or move the data
to a new worksheet. I am/was trying to use an array of cells that are
coppied and then delete the entire row.
Obviously, and I use that word loosely, I still need to continue studying
arrays or learn methods such as in your suggestions.

[Hal]
Thank you for your informative replies Dave!
[/Hal]

--
Regards

VBA.Newb.Confused
XP Pro
Office 2007



"Dave Peterson" wrote:

I'm confused at what you're doing, but if you want to delete rows, it's usually
easier to start at the bottom and work your way to the top:

Dim iRow as long
dim FirstRow as long
dim LastRow as long

with worksheets("somesheetnamehere")
firstrow = 2 'headers could be in row 1
lastrow = .cells(.rows.count,"B").end(xlup).row
for irow = lastrow to firstrow step -1
if lcase(.cells(irow,"B").value) = lcase("delete me") then
.rows(irow).delete
end if
next irow
end with

==========
A different option is to start from the top and work down, but build a range
(not an array) that can be deleted later. This method could fail if the range
has a lot of cells and there's lots of gaps in it.

dim myCell as range
dim myRng as range
dim DelRng as range

with worksheets("somesheetnamehere")
set myrng = .range("B2",.cells(.rows.count,"B").end(xlup))
end with

for each mycell in myrng.cells
if lcase(mycell.value) = lcase("delete me") then
if delrng is nothing then
'prime the pump
set delrng = mycell
else
'add more to the delrng
set delrng = union(mycell,delrng)
end if
end if
next mycell

if delrng is nothing then
'nothing found to delete
else
delrng.entirerow.delete
end if

=====
Both are uncompiled and untested--watch for typos.

Rick S. wrote:

Hence my request for help?
This code was provided by other members and I am attempting to learn from
it. It is used in another module and functions properly, in this module I am
trying to use it to delete rows after the user makes selections. I have
found that deleting rows during selection throws off the counting during
selection and will omit rows from deletion.

The originating array code is as below, creating an array of selected sheets.
'======
Sub CopySelectSheets()

Dim N As Long
Dim ShtArray() As Variant
Dim Wks As Worksheet

For Each Wks In Worksheets
If Wks.Name < "ListA" Then
If Wks.Cells(4, "D").Value = 10 Then
N = N + 1
ReDim Preserve ShtArray(1 to N)
ShtArray(N) = Wks.Name
End If
End If
Next Wks

If N 0 Then
Sheets(ShtArray()).Copy After:=Sheets(ShtArray(N))
End If

End Sub
'======

The "goto" code scrolls to the cell that has a match.
'======
Application.Goto Reference:=Worksheets("Sheet1").Range(sh1cell.Addr ess), _
Scroll:=True
'======
Above is one string.
--
Regards

VBA.Newb.Confused
XP Pro
Office 2007

--

Dave Peterson