Solved

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

Posted on 2011-03-24
10
925 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
ScreenConnect 6.0 Free Trial

At ScreenConnect, partner feedback doesn't fall on deaf ears. We collected partner suggestions off of their virtual wish list and transformed them into one game-changing release: ScreenConnect 6.0. Explore all of the extras and enhancements for yourself!

 
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

PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

Question has a verified solution.

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

Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

810 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