If duplicate value found between sheets, copy and paste 'interior fill'

Question

I have this code that copies the 'interior fill' from column A sheet 1, and pastes it to column A sheet 2. It's supposed to skip values that aren't matches (ie. if Row 2 of both sheets have different values it wont activate) but right now its just doing a straight copy.

 Sub copyCombinedFormat()
'TO BE ADDED IN
' this copies the format for matching values in combined to the weekly report

Application.ScreenUpdating = False

  Dim cl As Range
  Dim RowNum As Long
  Dim m As Variant
  
  Set m = Application.Match(cl.Value, Sheets("Weekly Report").Range("A:A"), 0)
  
  If Not IsError(m) Then
  
     For Each cl In Intersect(Sheets("Weekly Report").Range("A:A"), Sheets("Weekly Report").UsedRange)
        RowNum = 0
        RowNum = Application.Match(cl.Value, Sheets("Combined").Range("A:A"), 0)

        If RowNum <> 0 Then
           cl.Interior.color = Sheets("Combined").Range("A" & Application.Match(cl.Value, Sheets("Weekly Report").Range("A:A"), 0)).Interior.color
        End If
     Next cl
     
End If

  End Sub

Any input appreciated

Get rid of the `On Error Resume Next`. And use `IsError` and `Application.Match`, demonstrated [here](https://stackoverflow.com/a/17751568/9245853). — BigBen, Apr 01 '22 at 14:09
Also, [use `Long`, not `Integer`](https://stackoverflow.com/questions/26409117/why-use-integer-instead-of-long). — BigBen, Apr 01 '22 at 14:11
`Dim m As Variant`, `m = Application.Match(cl.Value, Sheets("2").Range("A:A"), 0)`, `If Not IsError(m) Then`. Basically if `m` isn't an error, then it's the row number. — BigBen, Apr 01 '22 at 14:24
@BigBen edited post to include updated code, think I my have issues with the flow — Bob Mackenzie, Apr 01 '22 at 14:42

score 1 · Answer 1 · answered Apr 01 '22 at 14:50

As mentioned in the comments:

Remove On Error Resume Next, that's hiding all errors.
It may be easier to use Application.Match and IsError. Make sure that you assign the result to a Variant variable (here rowNum). If there is no match, rowNum will be an error value, so test with IsError before attempting to use rowNum with Cells.

Dim ws2 As Worksheet
Set ws2 = ThisWorkbook.Worksheets("2")

With ThisWorkbook.Worksheets("Weekly Report")
     Dim cl As Range
     For Each cl in Intersect(.Range("A:A"), .UsedRange)
         Dim rowNum As Variant
         rowNum = Application.Match(c.Value, ws2.Range("A:A"), 0)

         If Not IsError(rowNum) Then
             cl.Interior.Color = ws2.Cells(rowNum, "A").Interior.Color
         End If
     Next
End With

If duplicate value found between sheets, copy and paste 'interior fill'

1 Answers1