Solved

Excel vba cut & paste rows based on interior cell color of column

Posted on 2011-03-24
10
951 Views
Last Modified: 2012-05-11
Hi! I have a worksheet "Open" that has cells in column J that are conditionally colored "vbYellow". I need to have the rows with the cells in col. J colored yellow to be moved to below the last line of data on sheet "Resolved". Is there a simple macro that can do this? Experts-Exchange-Resolved-Events.xlsm
0
Comment
Question by:McQMom
  • 6
  • 4
10 Comments
 
LVL 22

Expert Comment

by:rspahitz
ID: 35209374
Is this something you will be doing over and over?  If not, you don't need VBA.

To copy just the yellow cells, go to the top of the column of data and turn on filters.  Then select the filter button and choose "Filter by color" and pick yellow.

With this list, it's now easy to cut the pieces you want and go to the Resolved sheet and paste them at the end.
then go and turn off the filter to get the original data back.
0
 

Author Comment

by:McQMom
ID: 35209397
This is something we do every single day so I'm hoping to automate it.
0
 
LVL 22

Expert Comment

by:rspahitz
ID: 35209401
Correction, you can't cut and paste filtered data; you need to copy then paste and come back and delete the filtered rows.
0
Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
LVL 22

Expert Comment

by:rspahitz
ID: 35209410
Let me see about giving you a macro...
0
 

Author Comment

by:McQMom
ID: 35209463
That would be great. Thx
0
 
LVL 22

Expert Comment

by:rspahitz
ID: 35209740
Make a copy of your workbook then add this code to VB and run it to see if it gives you what you want.  I haven't fully tested it so let me know if you have any issues.
 
Sub MoveHilightedItems()
    Dim objStartCell As Range
    Dim iRow As Integer
    Dim iColumn As Integer
    
    Set objStartCell = ActiveCell
    
    Range("B1").Select
    
    Selection.AutoFilter
    Range("B1").End(xlDown).Select
    
    iRow = ActiveCell.Row
    iColumn = ActiveCell.Column
    
    ActiveSheet.Range("$A$1:$B$" & iRow).AutoFilter Field:=2, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
    Rows("1:" & iRow).Select
    Selection.Copy
    Sheets("Resolved").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    iRow = ActiveCell.Row
    Cells(iRow + 1, 1).Select
    
    ActiveSheet.Paste
    Sheets("Open").Select
    Application.CutCopyMode = False
    Selection.Cut
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    
    objStartCell.Select
    Set objStartCell = Nothing
End Sub

Open in new window

0
 

Author Comment

by:McQMom
ID: 35209986
All it moved was the headers in row 1
0
 
LVL 22

Accepted Solution

by:
rspahitz earned 500 total points
ID: 35210712
Sorry...I forgot to check your original sheet.  It seems that the yellow is in column J, not column B

So here, with some minor adjustments to make it work a bit better, especially since I see you already have filters turned on.
 
Sub MoveHilightedItems()
    Dim objStartCell As Range
    Dim iRow As Integer
    Dim iColumn As Integer
    Dim iDestinationBlankRow As Integer
    
    Set objStartCell = ActiveCell
    
    Sheets("Resolved").Select
    ActiveSheet.Range("A1").Select
    ActiveSheet.Range("A1").End(xlDown).Select
    iDestinationBlankRow = ActiveCell.Row + 1
    Sheets("Open").Select
    
    Range("J1").Select
    
    'Selection.AutoFilter
    Range("J1").End(xlDown).Select
    
    iRow = ActiveCell.Row
    iColumn = ActiveCell.Column
    
    ActiveSheet.Range("$A$1:$J$" & iRow).AutoFilter Field:=10, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
    Rows("2:" & iRow).Select
    Selection.Copy
    Sheets("Resolved").Select
    ActiveSheet.Cells(iDestinationBlankRow, 1).Select
    
    ActiveSheet.Paste
    Sheets("Open").Select
    Application.CutCopyMode = False
    Selection.Cut
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Range("$A:$U").AutoFilter Field:=10

    If Not objStartCell Is Nothing Then
        On Error Resume Next
        objStartCell.Select
        Set objStartCell = Nothing
    End If
End Sub

Open in new window


You can add this directly to the code window for the Open tab.
0
 

Author Closing Comment

by:McQMom
ID: 35210751
That was perfect. Thank you so much!!!
0
 
LVL 22

Expert Comment

by:rspahitz
ID: 35210764
Whew!  Good :)

BTW I see that you have several different modules in VBA, each with one macro/procedure.  You can combine these into a single module unless you have a reason to keep them separate.  And unless you are specifically referencing a module (Module1.xxx) then a simple copy/paste/remove old module will do the trick.
enjoy!
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

820 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question