Excel copy all values from sheet 1 & 2 that are highlighted/yellow to sheet 3

1
votes

I have an excel workbook with 3 sheets, the first two contain lots of data and the third is blank.

I want to create a macro that copies all the highlighted/yellow cells from sheet 1 & 2 and pastes them in sheet 3.

I have some code in a macro which at the minute is only to copy sheet 1 to sheet 3 but it copies everything even though i have used If .Interior.ColorIndex

Sub Yellow()
Dim LR As Long, i As Long, j As Long
j = 1
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
    With Worksheets("Sheet1").Range("A1:CF200" & i)
       If .Interior.ColorIndex Like 27 Or 12 Or 36 Or 40 Or 44 Then
            .Copy Destination:=Worksheets("Sheet3").Range("J" & j)
            j = j + 1
        End If
    End With
Next i
End Sub
3
vbaexcelcopy-paste

3 Answers

2
votes

Your condition
.Interior.ColorIndex Like 27 Or 12 Or 36 Or 40 Or 44

always evaluates to True (any number except 0 is True) so in fact your condition is:
'condition' Or True Or True ...
should be: 

  `.Interior.ColorIndex Like 27 _ 
  Or .Interior.ColorIndex Like 12 _
  Or .Interior.ColorIndex Like 36 _
  Or .Interior.ColorIndex Like 40 _
  Or .Interior.ColorIndex Like 44`

or better rewritten as:

Select Case .Interior.ColorIndex
    case 27,12,36,40,44
        'action
    Case Else
        'do nothing
End Select
2
votes

UPDATE: code below modified to skip yellow-highlighted cells that are blank...

I might break this one up into two sections, a script that does the looping through sheets and a function that checks if a cell (Range) is yellow. The code below has lots of comments which walk through the steps:

Option Explicit
Sub PutYellowsOnSheet3()

Dim Sh As Worksheet, Output As Worksheet
Dim LastRow As Long, LastCol As Long
Dim Target As Range, Cell As Range, Dest As Range
Dim DestCounter As Long

'initialize destination counter and set references
DestCounter = 1
Set Output = ThisWorkbook.Worksheets("Sheet3")

'loop through sheets that are not named "Sheet3"
For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name <> "Sheet3" Then
        With Sh
            LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            LastCol = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
            Set Target = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
        End With
        For Each Cell In Target '<~ loop through each cell in the target space
            If AmIYellow(Cell) And Cell.Value <> "" Then '<~ blank check too
                Set Dest = Output.Cells(DestCounter, 1)
                Cell.Copy Dest
                DestCounter = DestCounter + 1 '<~ keep incrementing on sheet 3
            End If
        Next Cell
    End If
Next Sh

End Sub

'call this function when you'd like to check if a range is yellow
Public Function AmIYellow(Cell As Range) As Boolean
    If Cell Is Nothing Then
        AmIYellow = False
    End If
    Select Case Cell.Interior.ColorIndex '<~ this is the yellow check
        Case 27, 12, 36, 40, 44
            AmIYellow = True
        Case Else
            AmIYellow = False
    End Select
End Function
1
votes

There are several mistakes to be found in your script. I think you want to loop all the cells in the given range and copy over only the cells that have the specified colors. That could be done like this:

Sub jzz()
Dim LR As Long, i As Long, j As Long
Dim c As Range
j = 1
LR = Range("A" & Rows.Count).End(xlUp).Row
For Each c In Worksheets("Blad1").Range("A1:G" & LR)
      If c.Interior.ColorIndex = 6 Then
            c.Copy Destination:=Worksheets("Blad2").Range("A" & j)
            j = j + 1
        End If
Next c
End Sub

You will need to modify the code somewhat, for example "Blad1" will not exist in your workbook, and I took only ColorIndex = 6