Excel Challenge: Macro based on cells background color - cut/paste and copy down

L

lost_in_macros

New Member
Joined
Apr 13, 2015
Messages
7
Hi awesome Mr. Excel community!

I am currently trying to create a rather complicated macro, and as you might have guessed by my user name, I am a bit lost right now.

This is how my data is currently shaped: I have one column which contains the data of owners (turquoise background, bgcolor=#CCFFFF or color=34 ) and tasks (white background). The number of owners, and the number of tasks per owner varies.[TABLE="class: outer_border, width: 500, align: center"]
<tbody>[TR]
[TD]
[/TD]
[TD]A[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Owner[/TD]
[TD]Task[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]
[/TD]
[TD]Anna (turquoise background)[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]
[/TD]
[TD]Task 1 (white background)[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]
[/TD]
[TD]Task 2 (white background)[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]
[/TD]
[TD]Lisa (turquoise background)[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]
[/TD]
[TD]Task 3 (white background)[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]
[/TD]
[TD]Task 4 (white background)[/TD]
[/TR]
</tbody>[/TABLE]


This is how I want my data to look like:

[TABLE="class: outer_border, width: 500, align: center"]
<tbody>[TR]
[TD]
[/TD]
[TD]A[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Owner[/TD]
[TD]Task[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Anna[/TD]
[TD]Task 1[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Anna[/TD]
[TD]Task 2[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Lisa[/TD]
[TD]Task 3[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]Lisa[/TD]
[TD]Task 4[/TD]
[/TR]
</tbody>[/TABLE]


What I want my Macro to do:

Cut all turquoise cells in column B and paste them into column A (two columns to the left). Then, starting from the first filled cell in column A, I want my macro to copy this cell into the empty cells in the rows below until it reaches the next filled cell. Then, I want it to go down one cell, copy this new cell and paste it into all the empty cells below until it gets to the next filled cell. I want this to happen until it reaches the end of the data (so some sort of if...then copy..until..then go down one..then loop construction). In the end, I would like every row with an empty cell in B to be deleted.

I know this is quite a complicated request, so all suggestions are welcome! Please reach out to me if you have any additional questions, and have a great day!
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Sort by date Sort by votes
Hi and welcome to the MrExcel Message Board.



If you want a macro solution you could try this:

Code: 
Sub Rearrange()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim iRow As Long, rowOut As Long
    Dim Owner As String
    
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")
    
    'ws2.Cells.Clear
    
    With ws1
        ws2.Range("A1:B1").Value = .Range("A1:B1").Value
        rowOut = 2
        For iRow = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
            If .Cells(iRow, "B").Interior.Color = RGB(255, 255, 255) Then
                ws2.Cells(rowOut, "B").Value = .Cells(iRow, "B").Value
                ws2.Cells(rowOut, "A").Value = Owner
                rowOut = rowOut + 1
            Else
                Owner = .Cells(iRow, "B").Value
            End If
        Next   
    End With

End Sub

It needs to be pasted into a new Module in the Excel VB Editor.

Basically, it looks for white cells in column B. If it finds one it adds it to column B on Sheet2. If it finds a different colour then it assumes it is an owner so should be put into column A.

I have left in the statement that could clear sheet2. The initial single quote needs to be removed to make it active. (I am not sure if you will need that.)
 
Upvote 0
Thank you so much for this macro, RickXL! This is helping me progress a lot faster. I am currently busy trying to include a third row with projects, so that for each entry I have the owner, the project and the task. I will let you know how it goes, or I might come back with another question.

Thanks for the quick response!
 
Upvote 0
Here is another macro for you to consider...
Code: 
Sub MoveNamesAssociateWithTasks()
  Dim Cell As Range, FirstAddress As String
  Application.FindFormat.Clear
  Application.FindFormat.Interior.ColorIndex = 34
  With Range("B2", Cells(Rows.Count, "B").End(xlUp))
    Set Cell = .Find("", SearchFormat:=True)
    If Not Cell Is Nothing Then
      FirstAddress = Cell.Address
      Do
        Cell.Copy Cell.Offset(, -1)
        Cell.Clear
        Set Cell = .Find("", Cell, SearchFormat:=True)
      Loop While Not Cell Is Nothing
    End If
    .Offset(, -1).SpecialCells(xlBlanks).FormulaR1C1 = "=R[-1]C"
    .Offset(, -1).Value = .Offset(, -1).Value
    .SpecialCells(xlBlanks).EntireRow.Delete
  End With
End Sub
 
Upvote 0
Hi Rick,

thank you so much! I am busy trying to incorporate a third component (projects, background color is bgcolor=#666699 color=47) as part of this reshaping effort es well. I will walk through your macro, and might come back with some questions. Thank you so much for your help so far!

[TABLE="class: cms_table_outer_border, width: 500, align: center"]
<tbody>[TR]
[TD]
[/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Owner[/TD]
[TD]Project[/TD]
[TD]Task[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]Anna (turquoise background)[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]Project 1 (purple background)[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]Task 1 (white background)[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]Task 2 (white background)[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]Lisa (turquoise background)[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]Project 2 (purple background)[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]Task 3 (white background)[/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]Task 4 (white background)[/TD]
[/TR]
</tbody>[/TABLE]



[TABLE="class: cms_table_outer_border, width: 500, align: center"]
<tbody>[TR]
[TD]
[/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Owner[/TD]
[TD]Project[/TD]
[TD]Task[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Anna[/TD]
[TD]Project 1[/TD]
[TD]Task 1[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Anna[/TD]
[TD]Project 1[/TD]
[TD]Task 2[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Lisa[/TD]
[TD]Project 2[/TD]
[TD]Task 3[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]Lisa[/TD]
[TD]Project 2[/TD]
[TD]Task 4[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Please, in the future, do not simplify your question for us... ask your full question the first time. Otherwise you just make more work for the volunteers you are asking to help you (we have to set up a test worksheet, write the code, test it, post it, only to have throw it all out and start over again when you come back and tell us the real question you have).

Give this macro a try...
Code: 
Sub MoveNamesAssociateWithTasks()
  Dim X As Long, Cell As Range, FirstAddress As String, V As Variant
  Application.FindFormat.Clear
  With Range("C2", Cells(Rows.Count, "C").End(xlUp))
    For X = 1 To 2
      Application.FindFormat.Interior.ColorIndex = Split("34 47")(X - 1)
      Set Cell = .Find("", SearchFormat:=True)
      If Not Cell Is Nothing Then
        FirstAddress = Cell.Address
        Do
          Cell.Copy Cell.Offset(2 - X, X - 3)
          Cell.Clear
          Set Cell = .Find("", Cell, SearchFormat:=True)
        Loop While Not Cell Is Nothing
      End If
    Next
    With Intersect(.SpecialCells(xlConstants).EntireRow, Columns("A:B"))
      .FormulaR1C1 = "=R[-1]C"
    End With
    .Offset(, -2).Resize(, 2).Value = .Offset(, -2).Resize(, 2).Value
    .SpecialCells(xlBlanks).EntireRow.Delete
  End With
End Sub
 
Upvote 0
Hi Rick,

I am sorry if this created confusion, thanks for clarifying Forum rules. Thank you for this code, it works great for the project section! It does not copy down the Owner name correctly though. I am not sure if I understand it correctly, but it seems that it goes off the task cell and then copies the owner cell that it can find in the row above. This is what I see

1. visible step in Macro: copies purple and turqoise cells [TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Owner[/TD]
[TD]Project[/TD]
[TD]Task[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Lisa[/TD]
[TD]Project 1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD][/TD]
[TD]Project 2[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD][/TD]
[TD][/TD]
[TD]Task 1[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD][/TD]
[TD][/TD]
[TD]Task 2[/TD]
[/TR]
</tbody>[/TABLE]

2. visible step: copies down Owner and Project

[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Owner[/TD]
[TD]Project[/TD]
[TD]Task[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Lisa[/TD]
[TD]Project 1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD][/TD]
[TD]Project 2[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]0[/TD]
[TD]Project 2[/TD]
[TD]Task 1[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]0[/TD]
[TD]Project 2[/TD]
[TD]Task 2[/TD]
[/TR]
</tbody>[/TABLE]


It would be great to get to this outcome:

[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Owner[/TD]
[TD]Project[/TD]
[TD]Task[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Lisa[/TD]
[TD]Project 1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Lisa[/TD]
[TD]Project 2[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Lisa[/TD]
[TD]Project 2[/TD]
[TD]Task 1[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]Lisa[/TD]
[TD]Project 2[/TD]
[TD]Task 2[/TD]
[/TR]
</tbody>[/TABLE]




Thank you for the time and effort you already put into this, I really appreciate it, and I hope I am not asking too much.
 
Upvote 0
lost_in_macros said:
Thank you for this code, it works great for the project section! It does not copy down the Owner name correctly though
Click to expand...
I test the code before I posted it and I tested it again just now... it works correctly for me. Is your layout exactly like you showed in Message #5 with the owner cell's ColorIndex equal to 34 and the project cell's ColorIndex equal to 47?
 
Upvote 0
Hi Rick,

it is, but what it doesn't show is that one person might have several projects assigned to them, and it won't say the person's name in the row above every project. It might be that e.g. Lisa has 5-10 projects assigned to her, and each project has any given number of tasks.

I am sorry for the inconvenience this is causing, please let me know if there is any additional information that you need. Thank you very much!
 
Upvote 0
lost_in_macros said:
Hi Rick,

it is, but what it doesn't show is that one person might have several projects assigned to them, and it won't say the person's name in the row above every project. It might be that e.g. Lisa has 5-10 projects assigned to her, and each project has any given number of tasks.
Click to expand...
Sorry, I had misunderstood your data layout. Give this macro a try...
Code: 
Sub MoveNamesAssociateWithTasks()
  Dim X As Long, Cell As Range, FirstAddress As String, V As Variant
  Application.FindFormat.Clear
  With Range("C2", Cells(Rows.Count, "C").End(xlUp))
    For X = 1 To 2
      Application.FindFormat.Interior.ColorIndex = Split("34 47")(X - 1)
      Set Cell = .Find("", SearchFormat:=True)
      If Not Cell Is Nothing Then
        FirstAddress = Cell.Address
        Do
          Cell.Copy Cell.Offset(2 - X, X - 3)
          Cell.Clear
          Set Cell = .Find("", Cell, SearchFormat:=True)
        Loop While Not Cell Is Nothing
      End If
    Next
    .Offset(, -2).Resize(, 2).SpecialCells(xlBlanks).FormulaR1C1 = "=R[-1]C"
    .Offset(, -2).Resize(, 2).Value = .Offset(, -2).Resize(, 2).Value
    .SpecialCells(xlBlanks).EntireRow.Delete
  End With
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
cut/copy and paste row based on cell value not being equal to specific text
Replies
6
Views
415
mlan1604
M
Q
  • Question Question
Macro needed to insert 4 rows in table, copy data from above, copy data from another sheet and paste special (transpose values) to those new rows...re
Replies
1
Views
229
sijpie
sijpie
S
  • Question Question
Macro: Search and then copy the result and paste into Excel
Replies
0
Views
507
Siops
S
D
  • Question Question
VBA code that loops through a range and copies and pastes the data below
Replies
2
Views
305
danbates77
D
B
  • Question Question
VBA code to cut and paste multiple filtered rows based on multiple criteria
Replies
2
Views
1K
Alex Blakenburg
A

Forum statistics

Threads
1,223,243
Messages
6,170,971
Members
452,371
Latest member
Frana

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top