Copy rows if Interior.ColorIndex = 20

[JaimeMabini]

Hello VBA Guru's,

Summary:

I have here a code the compare Workbook A sheet1 to Workbook B sheet1. If attributes in Workbook A sheet1 column A is found in Workbook B sheet1 column A, then copy the entire row from Workbook A sheet1 and paste to Workbook B sheet1 and saveas new copy. This is all working with the code I have below:

Sub UpdateSheet()

'On Error Resume Next

  Dim i As Long
  Dim f As Range, c As Range
  Dim message
  Dim my_FileName As Variant
  Dim NewName As Variant
  Dim xWB As Workbook
 
  
  'Parameters taken from RDS Converter sheet
  Sheets("RDS Converter").Select
  break = Range("C9").Value
  PathName = Range("C7").Value
  this = Range("C8").Value
  NewPath = Range("C11").Value
  
   'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
  Application.DisplayAlerts = False
  
  ' Will take the old workbook to convert to new version
  my_FileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*", Title:="Select file", MultiSelect:=False)
  
  If my_FileName = False Then
  
  Exit Sub 'Exits if no file selected
  
  Else
  
  'Remove path from full filename
    NewName = Dir(my_FileName)
  
  End If
  
  Set wb = Workbooks.Open(Filename:=PathName & this)
  
  DoEvents
  
  With wb.Sheets("OKTOP® CONFIGURATOR")
    For Each c In .Range("A1", .Range("A" & Rows.Count).End(3))
    
    'inserts a new column
    Range("E:E").EntireColumn.Insert
    'clear formats of new inserted column
    Worksheets("OKTOP® CONFIGURATOR").Range("E:E").ClearFormats
    
        If c.Row > break Then
             'MsgBox ("Row " & break & " Reached")
            GoTo ExitA 'End
            
        Else
            Set f = Workbooks.Open(my_FileName).Sheets("OKTOP® CONFIGURATOR").Range("A:A").Find(c.Value, , xlValues, xlWhole, , , False)
           
            If Not f Is Nothing Then 'And f.Interior.ColorIndex = 20
                f.EntireRow.Copy
                .Range("A" & c.Row).PasteSpecial xlValues
                .Range("E" & c.Row).Value = "Yes"
          
            Else
            
                .Range("E" & c.Row).Value = "No"
                               
        End If
    End If


Next
ExitA:

'Save as copy procedure
  Workbooks("RDS Converter.xlsm").Activate
  Workbooks(this).SaveCopyAs NewPath & "NEW_" & Left(NewName, Len(NewName) - 14) & this
  Workbooks(this).Close SaveChanges:=False
  
'close all other running applications
For Each xWB In Application.Workbooks

    If Not (xWB Is Application.ActiveWorkbook) Then
        xWB.Close
End If
    
Next

End With

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    
  MsgBox ("Row " & break & " Reached..." & vbCrLf & vbCrLf & "Process Done!")
      
  
End Sub

Now What I need is to add a new rule to the existing one, that the copy will only proceed if Column C has Interior.ColorIndex = 20. I think I need to add this rule somewhere here:

Set f = Workbooks.Open(my_FileName).Sheets("OKTOP® CONFIGURATOR").Range("A:A").Find(c.Value, , xlValues, xlWhole, , , False)
           
            If Not f Is Nothing Then 'And f.Interior.ColorIndex = 20
                f.EntireRow.Copy
                .Range("A" & c.Row).PasteSpecial xlValues
                .Range("E" & c.Row).Value = "Yes"

I was able to satisfy the rule of Interior.ColorIndex = 20 by adding If Not f Is Nothing And f.Interior.ColorIndex = 20 Then . but it is reading from Range("A:A"). How can I add here that this Interior.ColorIndex = 20 should be base on column C.

Any help will be highly appreciated.

I've been working on this for days now and it seems that my missing logic was fairly simple but I can't seem to find the correct combination ?

 

[Domenic]

Try . . .

    If Not f Is Nothing Then
        If f.Offset(, 2).Interior.ColorIndex = 20 Then
            f.EntireRow.Copy
            'etc
            '
            '
        End If
    End If

Hope this helps!

 

[JaimeMabini]

Try . . .

    If Not f Is Nothing Then
        If f.Offset(, 2).Interior.ColorIndex = 20 Then
            f.EntireRow.Copy
            'etc
            '
            '
        End If
    End If

Hope this helps!

Hello Domenic,

Thank you for the help. But unfortunately, the code doesn't work how it should be.

Set f = Workbooks.Open(my_FileName).Sheets("OKTOP® CONFIGURATOR").Range("A:A").Find(c.Value, , xlValues, xlWhole, , , False)
            Workbooks(my_FileName).Activate
           
            If Not f Is Nothing Then
            If f.Offset(, 2).Interior.ColorIndex = 20 Then
                f.EntireRow.Copy
                .Range("A" & c.Row).PasteSpecial xlValues
                .Range("E" & c.Row).Value = "Yes"
          
            Else
            
                .Range("E" & c.Row).Value = "No"
                               
        End If
    End If
End If

After inserting your code to this job. the copy paste job doesn't work at all.

 

[JaimeMabini]

Hello Domenic,

Thank you for the help. But unfortunately, the code doesn't work how it should be.

Set f = Workbooks.Open(my_FileName).Sheets("OKTOP® CONFIGURATOR").Range("A:A").Find(c.Value, , xlValues, xlWhole, , , False)
            Workbooks(my_FileName).Activate
          
            If Not f Is Nothing Then
            If f.Offset(, 2).Interior.ColorIndex = 20 Then
                f.EntireRow.Copy
                .Range("A" & c.Row).PasteSpecial xlValues
                .Range("E" & c.Row).Value = "Yes"
         
            Else
           
                .Range("E" & c.Row).Value = "No"
                              
        End If
    End If
End If

After inserting your code to this job. the copy paste job doesn't work at all.

Hello Domenic,

I got it to work by creating a variable call for my Interior.ColorIndex and using them to call .Offset(, 2).Interior.ColorIndex = myVar. For some reason Interior.ColorIndex = 20 is not working but Interior.ColorIndex = 3 is working. With this case, I tried creating the variable and it works like a charm.

Dim myVar As Long
myVar = Range("C13").Interior.ColorIndex
If c.Offset(, 2).Interior.ColorIndex = myVar Then 'and so on.....

Thank you again.