Solved

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

Posted on 2011-03-24
10
882 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
 
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
What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

 
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

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

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…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

760 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

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now