Copy value from cell based on colour

[Sophia Hickman]

I have the following sheet, to be used for invoicing purposes.
Our client has requested us to colour in each box that we are applying for that month, however there is no tally or record of total monies claimed for in that month.

I am hoping someone can help me, for each cell that i colour in yellow as below - i would like this value to populate on another tab/sheet

	Plot 1	Plot 1	Plot 2	Plot 2	Plot 3	Plot 3	Plot 4	Plot 4
Description		Garage		Garage		Garage		Garage
	Private	Private	Private	Private	Private	Private	Private	Private
1st Fix	£2,034.75	£82.80	£1,898.85	£82.80	£1,898.85	£82.80	£2,370.90	£82.80
2nd Fix	£2,110.50	£124.20	£1,959.50	£124.20	£1,959.50	£124.20	£2,484.00	£124.20
Finals	£192.75		£177.65		£177.65		£230.10
Door Entry
A.O.V

 

[mrmmickle1]

Hey Sophia-

Please try something like this:

Sub Test()

Dim rng As Range
Dim cll As Range
Dim tgtSht As Worksheet
Dim intCnt As Integer

Set rng = Sheets("Sheet1").Range("A1:I9") 'define range to loop through...i.e. this is where you define what range to look through
Set tgtSht = Sheets.Add 'Add New Worksheet to put values

'Loop through each cell in the range and identify if it is "Yellow"...
For Each cll In rng
    If cll.Font.Color = 6609655 Then
        'If the cell is "Yellow" move the value to another worksheet
        tgtSht.Cells(intCnt + 1, 1) = cll.Value
        intCnt = intCnt + 1 'increment counter in order to move to the next available row
    End If
Next cll

End Sub

 

[Sophia Hickman]

Hey Sophia-

Please try something like this:

Sub Test()

Dim rng As Range
Dim cll As Range
Dim tgtSht As Worksheet
Dim intCnt As Integer

Set rng = Sheets("Sheet1").Range("A1:I9") 'define range to loop through...i.e. this is where you define what range to look through
Set tgtSht = Sheets.Add 'Add New Worksheet to put values

'Loop through each cell in the range and identify if it is "Yellow"...
For Each cll In rng
    If cll.Font.Color = 6609655 Then
        'If the cell is "Yellow" move the value to another worksheet
        tgtSht.Cells(intCnt + 1, 1) = cll.Value
        intCnt = intCnt + 1 'increment counter in order to move to the next available row
    End If
Next cll

End Sub

Thank you Matt, I have very basic excel knowledge, when i have written the below it is saying there is a bug! I have highlighted the row that it doesnt like below, any help would be great.
basically i am looking to duplicate the payment schedule sheet on another tab (we total sheet) but only when i colour in the cell on the payment sheet.

Sub Test()

Dim rng As Range
Dim cll As Range
Dim tgtSht As Worksheet
Dim intCnt As Integer

Set rng = Sheets("DURK-BENG PAYMENT SCHEDULE").Range("B12:P71")
Set tgtSht = Sheets("WE TOTAL SHEET").Add

For Each cll In rng
If cll.Font.Color = 6609655 Then
tgtSht.Cells(intCnt + 1, 1) = cll.Value
intCnt = intCnt + 1
End If
Next cll

End Sub

 

[mrmmickle1]

Please try the code with a few modifications:

Sub Test()

Dim rng As Range
Dim cll As Range
Dim intCnt As Integer

Set rng = Sheets("DURK-BENG PAYMENT SCHEDULE").Range("A1:I9") 'define range to loop through...i.e. this is where you define what range to look through
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "WE TOTAL SHEET" 'Add New Worksheet named WE TOTAL SHEET to put values

'Loop through each cell in the range and identify if it is "Yellow"...
For Each cll In rng
    If cll.Font.Color = 6609655 Then
        'If the cell is "Yellow" move the value to another worksheet
        Cells(intCnt + 1, 1) = cll.Value
        intCnt = intCnt + 1 'increment counter in order to move to the next available row
    End If
Next cll

End Sub

 

[Sophia Hickman]

Please try the code with a few modifications:

Sub Test()

Dim rng As Range
Dim cll As Range
Dim intCnt As Integer

Set rng = Sheets("DURK-BENG PAYMENT SCHEDULE").Range("A1:I9") 'define range to loop through...i.e. this is where you define what range to look through
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "WE TOTAL SHEET" 'Add New Worksheet named WE TOTAL SHEET to put values

'Loop through each cell in the range and identify if it is "Yellow"...
For Each cll In rng
    If cll.Font.Color = 6609655 Then
        'If the cell is "Yellow" move the value to another worksheet
        Cells(intCnt + 1, 1) = cll.Value
        intCnt = intCnt + 1 'increment counter in order to move to the next available row
    End If
Next cll

End Sub

Thanks Matt

This now opens a new tab named WE TOTAL SHEET

However when i press run, it doesnt pull through any figures

Have tried changing the colour to 6609655 (R:100, G:218, B:247) but still not working

Any other ideas please? I feel its super close now but not quite there

 

[mrmmickle1]

When I look at the color based on your post I have:

Red: 247 ; Green: 218 ; Blue: 100

If you highlight a cell with the coloring in it can you run this macro and validate the font color?

Sub GetColor()
   MsgBox ActiveCell.Font.Color
End Sub

Is the cell actually colored or is this conditional formatting?