Move Flagged Row(s) to a Different Sheet

[Neon520]

Hi Everyone,

I'm sure this is a piece of cake for most of you who are familiar with
programming in Excel, but it's a bit challenge for me.

I'd like to know how to program in Excel so that rows that have been flagged
with some identifier will be move to a different sheet, for example:
In Sheet1, Col A is the flag column. It will be a drop down list. Let's
say if Sheet1 Col A says "DELETE" then that entire row show be move to the
sheet called "MOVE". Since Sheet1 is to be certain amount of row, I don't
want to Cut the entire row to the sheet "MOVE." I'd like to move the data and
the formatting only and leave the amount of row in Sheet1 the same after
moving.

I'd like to link the code with a button, just so that the user can click
when he/she is ready to do so.

Thank you so much for any advice/help!

Neon520

 

[marcus]

Hi Neon

Try this for size. Uses auto filter to move data. You might want to
consider clearing the range of the destination sheet or putting the
new data at the bottom of that range. You will have to change the
amount of columns in the code to suit your needs as I used 6.

Take care

Marcus

Option Explicit
Sub MoveData()

Dim Rng As Range
Dim lw As Integer

Application.ScreenUpdating = False
Set Rng = Range([A1], Range("A" & Rows.Count).End(xlUp))

With Rng ' use autofilter
.AutoFilter , Field:=1, Criteria1:="Delete" 'Criteria DELETE
Range("A2").Select
lw = Range("A" & Rows.Count).End(xlUp).Row
Range(Cells(2, 1), Cells(lw, 6)).Copy Worksheets
("Sheet2").Range("A2")
.AutoFilter
End With

End Sub

 

[OssieMac]

By the following statement do you mean that you want to move all the data and
formatting but leave the blank row in the source worksheet?

"I'd like to move the data and the formatting only and leave the amount of
row in Sheet1 the same after moving."

 

[OssieMac]

Hi Neon,

I took a gamble that your answer to my previous post will be yes and if so,
the following code should do what you want. If you need help in attaching the
code to a button then please get back to me but let me know what version of
xl you are using so I can tailor the instructions to suit.

Sub MoveDeletes()
Dim wsSht1 As Worksheet
Dim wsMove As Worksheet
Dim rngColA As Range
Dim cel As Range

Set wsSht1 = Sheets("Sheet1")
Set wsMove = Sheets("Move")

With wsSht1
Set rngColA = .Range(.Cells(1, "A"), _
.Cells(.Rows.Count, "A").End(xlUp))
End With

With wsMove
For Each cel In rngColA
If cel.Value = "Delete" Then
cel.EntireRow.Cut Destination:= _
.Cells(.Rows.Count, "A") _
.End(xlUp).Offset(1, 0)

cel.EntireRow.ClearFormats
End If
Next cel
End With

End Sub

 

[Neon520]

Hi OssieMac,

Yes, I'd like to move all the data and formatting but leave the blank row in
the source worksheet, but since they are going to look empty in between
others row, it would be nice to insert a line of code that will sort them in
certain order so, that the user don't have to manually sort the data.

I'm using Excel 2004 for Mac, but I do know how to attach the the code to
the button, so that's not a problem for me.

I got "Run-time error ;91': Object variable or with block variable not set"
for the following code:

cel.EntireRow.Cut Destination:= _
.Cells(.Rows.Count, "A") _
.End(xlUp).Offset(1, 0)

Please allow me to explain myself in detail of what I need:
Currently, in my excel workbook, I have 3 sheets: 1. WaitList (aka source
worksheet) 2. Enrolled 3. Rejected.
WaiList sheet has Column A-O. Column K is the Status column (Enrolled,
Rejected, Waiting). I have set source worksheet to have 550 rows, and I'd
like to keep it in that amount even after move the data to other sheets.

Here is my idea of the code should look like:

Search the entire [WaitList] sheet

If Col K in [WaitList] is "Enrolled"
Then move the data from Col A to Col O to [Enrolled]

Else if Col K in [WaitList] is "Rejected"
Then move the data from Col A to Col O to [Rejected]

(append the data for [Enrolled and [Rejected] to the next row everyone time
the code is run)

Sort the [WaitList] by Col H in acsending order and then Col G in acsending
order.

I hope this help you in the processing of trying to comprehend my problem
better. I'm sorry that I change some of the term and column from the
original post.

Thank you so much,

Neon520

 

[OssieMac]

I tested with a PC and it appears to work. I don't have access to a Macintosh
so can't test under those conditions. However, did you edit your worksheet
names correctly in the following code.

Set wsSht1 = Sheets("Sheet1") 'this is the source sheet
Set wsMove = Sheets("Move") 'this is the destination sheet

Other than that, post the code with a question under the Mactintosh area and
someone might be able to help with whatever needs to be tweeked for Macintosh.

 

[Neon520]

Hi OssieMac,

I retry the code again with some small changes and this time it works!
However, there is a little tweak that I'd like to see if you can help me with:

I delete the code line: cel.EntireRow.ClearFormats because I do want to
preserve the formatting that is originally with Sheet1; however, even with
this code line deleted, I do still lose the border line that is originally in
Sheet1. Is there a way to preserve the border setting as well?

Also, could you include a couple more lines or code that will sort the
Sheet1 by ColA then ColB by ascending order after Transferring the info to
Move sheet?

Optional request (if possible, if not, that's fine)
Is it possible to show a textbox pop up saying that "there is no 'Delete'
Item in Sheet1 and press OK to quit" something like that? Just so the user
will know that...?

Thank you for your great help!!
Neon520

 

[OssieMac]

Hello again Neon,

Can do what you want but sorting in xl2007 and xl2002 is different code.
Therefore have included 2 examples of code. Don't know if either works in Mac
version. MsgBox displaying no deletes OK.

To keep the borders on the source have to copy and paste in lieu of cut and
paste. Therefore need to include line to delete old data but this time in
lieu of clearing all from the row, I have only cleared the contents which
leaves the borders in tact.

The sort code assumes that you have column headers. Note that sorting does
not sort the borders with the cells. The borders appear to remain in their
original location. Seems strange to me because if you have font colors or
interior colors in the cells then they sort with the data.

Example for xl2002 (I think xl2003 is same)
Sub MoveDeletes()
Dim wsSht1 As Worksheet
Dim wsMove As Worksheet
Dim rngColA As Range
Dim cel As Range
Dim bolDelete As Boolean
Dim rngKeyA As Range
Dim rngKeyB As Range

bolDelete = False 'Initialize

Set wsSht1 = Sheets("Sheet1")
Set wsMove = Sheets("Move")

With wsSht1
Set rngColA = .Range(.Cells(1, "A"), _
.Cells(.Rows.Count, "A").End(xlUp))
End With

With wsMove
For Each cel In rngColA
If cel.Value = "Delete" Then
bolDelete = True
cel.EntireRow.Copy Destination:= _
.Cells(.Rows.Count, "A") _
.End(xlUp).Offset(1, 0)

cel.EntireRow.ClearContents
End If
Next cel
End With

If bolDelete = False Then
MsgBox "Do deletes found"
Exit Sub
End If

Application.CutCopyMode = False

With rngColA
Set rngKeyA = .Cells(1, "A").Offset(1, 0)
Set rngKeyB = .Cells(1, "A").Offset(1, 1)
End With


rngColA.EntireRow.Sort Key1:=rngKeyA, _
Order1:=xlAscending, Key2:=rngKeyB, _
Order2:=xlAscending, _
Header:=xlYes, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal

End Sub
'End of xl2002 code
'****************************************

Example for xl2007
Sub MoveDeletes()
Dim wsSht1 As Worksheet
Dim wsMove As Worksheet
Dim rngColA As Range
Dim cel As Range
Dim bolDelete As Boolean
Dim rngKeyA As Range
Dim rngKeyB As Range

bolDelete = False 'Initialize

Set wsSht1 = Sheets("Sheet1")
Set wsMove = Sheets("Move")

With wsSht1
Set rngColA = .Range(.Cells(1, "A"), _
.Cells(.Rows.Count, "A").End(xlUp))
End With

With wsMove
For Each cel In rngColA
If cel.Value = "Delete" Then
bolDelete = True
cel.EntireRow.Copy Destination:= _
.Cells(.Rows.Count, "A") _
.End(xlUp).Offset(1, 0)

cel.EntireRow.ClearContents
End If
Next cel
End With

If bolDelete = False Then
MsgBox "Do deletes found"
Exit Sub
End If

Application.CutCopyMode = False
wsSht1.Sort.SortFields.Clear

With rngColA
Set rngKeyA = .Offset(1, 0) _
.Resize(.Rows.Count - 1, 1)

Set rngKeyB = .Offset(1, 1) _
.Resize(.Rows.Count - 1, 1)
End With

wsSht1.Sort.SortFields.Add Key:=rngKeyA, _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal

wsSht1.Sort.SortFields.Add Key:=rngKeyB, _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal

With wsSht1.Sort
.SetRange rngColA.EntireRow
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End Sub

 

[Neon520]

Hi OssieMac again!

I'm so glad that you get back to me.
Even though I don't know if xl2007 is working with xl2004 for Mac, but since
the code for xl2002 is working for me, I'm going to stick with it.

I'm a little struggle with the sorting part so I decide to record a Macro of
my sorting need and copy the code to your code. It works out for me, at
least so far.

I just need a little bit more help to tweak the code a bit more.
The flagged column also have another category beside "Delete", called
"Rejected" And if any rows flagged with "Reject" it will be moved to a third
sheet, called "Rejected".

Based on the code that you gave me, I was able to do that part, here is
something I couldn't figure out:

I need to have only ONE Message to announce if there is NO "Delete" and
"Rejected" found in Sheet1. Currently I just add another Boolean to flag the
"Rejected" and another Message Box. But that just doesn't seem right, so is
there a way to combine the message together? If possible, can the message
box says something like this?

In case that there are "Delete" and "Rejected" found:
There are 5 (x-amount) of "Delete" transfered.
There are 6 (y-amount) of "Rejected" transfered.

In case that there is NO "Delete" and Rejected" found:
No "Delete" found.
No "Rejected" found.

Can these two scenario be mixed and match? for example: No "Delete" found, 5
"Rejected" transfered.

I'm posting my last code below, but I've changed some of the code already,
but you may able to understand what I'm trying to explain to you. You may
ignore the code if you already understand what I"m saying.

'****** Start Code ********

Sub MoveEnrolled2()
Dim wsProvWaitList As Worksheet
Dim wsProvEnrolled As Worksheet
Dim rngColA As Range
Dim cel As Range
Dim bolEnrolled As Boolean
Dim rngKeyA As Range
Dim rngKeyB As Range

Dim bolRejected As Boolean 'Neon
Dim wsProRejected As Worksheet 'Neon

bolEnrolled = False 'Initialize
bolRejected = False 'Initialize 'Neon

Set wsProvWaitList = Sheets("ProvWaitList")
Set wsProvEnrolled = Sheets("ProvEnrolled")
Set wsProvRejected = Sheets("ProvRejected") 'Neon

With wsProvWaitList
Set rngColA = .Range(.Cells(1, "K"), _
..Cells(.Rows.Count, "K").End(xlUp))
End With

With wsProvEnrolled
For Each cel In rngColA
If cel.Value = "Enrolled" Then
bolEnrolled = True
cel.EntireRow.Copy Destination:= _
..Cells(.Rows.Count, "A") _
..End(xlUp).Offset(1, 0)

cel.EntireRow.ClearContents
End If
Next cel
End With

' Start Neon code ********

With wsProvRejected
For Each cel In rngColA
If cel.Value = "Rejected" Then
bolRejected = True
cel.EntireRow.Copy Destination:= _
..Cells(.Rows.Count, "A") _
..End(xlUp).Offset(1, 0)

cel.EntireRow.ClearContents
End If
Next cel
End With
' End Neon code **********

If bolEnrolled = False Then
MsgBox "No Enrolled found"
Exit Sub
End If

' Start Neon Code
If bolRejected = False Then
MsgBox "No Rejected found"
Exit Sub
End If
' End Neon Code

'**** Start Sorting Code *******
Columns("A:O").Select
Selection.Sort Key1:=Range("H2"), Order1:=xlAscending, Key2:=Range("G2") _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1,
MatchCase:=False _
, Orientation:=xlTopToBottom

'**** End Sorting Code *******


End Sub


' ****** End Code **********