code for select a group cut, paste and delete

P

Paulg

I have a spreadsheet of multiple rows with 1 column called
status. There are 10 or 20 different statuses possible.

I have a macro that sorts the spreadsheet by status. I
want to cut the ones in "primary" status and paste them to
the end of of the spreadsheet 1 line below the last
entry. I then want to delete the rows where "primary"
status was.

Thanks

P
 
T

Tom Ogilvy

Assume when you say a column is named Status, that it is a define/named
range and Range("Status").Column identifies the column number of that
column.

Dim rng as Range, rng1 as Range, rng2 as Range
Dim cell as Range
set rng = Range("Status").Find("primary", . . . ) ' add other args as
appropriate
if not rng is nothing then
set cell = rng.offset(1,0)
do while instr(1,cell,"primary",vbTextcompare) > 0
set cell = cell.offset(1,0)
Loop
set rng1 = Range(rng,cell.offset(-1,0))
set rng2 = cells(rows.count, Range("Status").column).End(xlup)(3)
rng1.Entirerow.copy Destination:= _
cells(rng2.row,1)
rng1.Entirerow.Delete
End if
 
G

Guest

Hi,

Loop down the column:

NumberofEntries is the number of entries you have - you
can get this from using =COUNT(A1:A1000) in some cell
(e.g. B1) and doing:

Range("B1").Select
NumberofEntries = ActiveCell.Value

dim loopval1 as integer
dim endpos1 as integer
dim cellval1 as string 'Or whatever type you want

endpos1 = NumberofEntries + 1

for loopval1 = 1 to NumberofEntries
Range("A" & loopval1).Select
if ActiveCell.Value = "Primary" then
cellval1 = ActiveCell.Value
Range("A" & endpos1).Select
ActiveCell.Value = cellval1
endpos1 = endpos1 + 1
Rows(loopval1).Select
Selection.Delete Shift:=xlUp
end if
next loopval1

Hope it works,
 
P

PaulG

It's almost working, but I get a syntax error on the
second variable Dim Cell as Range

P
 
T

Tom Ogilvy

Dim cell as range

is innocuous. You should not get an error. You will get an error on the
next line if you didn't correct it to include any appropriate arguments.
this version, with no additional arguments compiles fine:

Sub AAAtester2()
Dim rng As Range, rng1 As Range, rng2 As Range
Dim cell As Range
Set rng = Range("Status").Find("primary") ' add other args as

If Not rng Is Nothing Then
Set cell = rng.Offset(1, 0)
Do While InStr(1, cell, "primary", vbTextCompare) > 0
Set cell = cell.Offset(1, 0)
Loop
Set rng1 = Range(rng, cell.Offset(-1, 0))
Set rng2 = Cells(Rows.Count, Range("Status").Column).End(xlUp)(3)
rng1.EntireRow.Copy Destination:= _
Cells(rng2.Row, 1)
rng1.EntireRow.Delete
End If

End Sub
 
G

Guest

Got it, both ways actually. My problem was that the
column was not actually a defined/named range. Once I
fixed that it worked.

Thanks

P
 
Top