please make this code more efficient i am new

[ap123]

can someone make this code efficient

This code is meant to compare the revision between two workbooks

Sub Compare_Revision_MCC7021()

    'makes sure the button is only pushed when it is meant to be. simple check on the tab either side to make sure its the lastest Rev, and not the first'
    Rev_Number = Range("Z1")
    store = ActiveSheet.Index - 1
    store1 = ActiveSheet.Index + 1
    Next_Rev = Rev_Number + 1
    Previous = Rev_Number - 1
    If Worksheets(store1).Name <> "MCC7021 Rev " & Previous Then Exit Sub
    If Worksheets(store).Name = "MCC7021 Rev " & Next_Rev Then Exit Sub
  
    'variable used to count the removed cables, used later'
    Dim listing As Integer
    listing = 1
    Worksheets("Removed Cables").Range("B2:B100") = " "

    'steps through the cables'
    For cols = 7 To 500
  
        'stores all the cable info in there respective variable'
        Area_1 = Range("B" & cols)
        WBS_1 = Range("C" & cols)
        From_1 = Range("D" & cols)
        TAG_1 = Range("E" & cols)
        Power_1 = Range("F" & cols)
        Cable_1 = Range("G" & cols)
        FromD_1 = Range("H" & cols)
        ToD_1 = Range("I" & cols)
        Voltage_1 = Range("J" & cols)
        Length_1 = Range("K" & cols)
        Size_1 = Range("L" & cols)
        Cores_1 = Range("M" & cols)
        Type_1 = Range("N" & cols)
        Connection_1 = Range("O" & cols)
        Comments_1 = Range("P" & cols)
        REV_1 = Range("Q" & cols)
        Schematic_1 = Range("R" & cols)
        Block_1 = Range("S" & cols)
      
      
        'all of the following blocks of code follow the same formula'
        'using the cable number it looks up the desired cable infomation in the previous revision and compares it to the current revision'
        'if it is not the same it will highlight it blue (colour 37)'
        'if it is the same it is set to unhighlighted'
        'The "on error" lines of code just make sure that the code dosnt break if the cable isnt found in the previous revision'
      
      
        On Error Resume Next
        Area_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), 2, False)
        On Error GoTo 0
        If Area_1 <> Area_2 Then
        Range("B" & cols).Interior.ColorIndex = 37
        End If
        If Area_1 = Area_2 Then
        Range("B" & cols).Interior.ColorIndex = 0
        End If
      
        On Error Resume Next
        WBS_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), 3, False)
        On Error GoTo 0
        If WBS_1 <> WBS_2 Then
        Range("C" & cols).Interior.ColorIndex = 37
        End If
        If WBS_1 = WBS_2 Then
        Range("C" & cols).Interior.ColorIndex = 0
        End If
      
        On Error Resume Next
        From_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), 4, False)
        On Error GoTo 0
        If From_1 <> From_2 Then
        Range("D" & cols).Interior.ColorIndex = 37
        End If
        If From_1 = From_2 Then
        Range("D" & cols).Interior.ColorIndex = 0
        End If
      
      
        On Error Resume Next
        Power_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), 6, False)
        On Error GoTo 0
        If Power_1 <> Power_2 Then
        Range("F" & cols).Interior.ColorIndex = 37
        End If
        If Power_1 = Power_2 Then
        Range("F" & cols).Interior.ColorIndex = 0
        End If
      
        On Error Resume Next
        TAG_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), 5, False)
        On Error GoTo 0
        If TAG_1 <> TAG_2 Then
        Range("E" & cols).Interior.ColorIndex = 37
        End If
        If TAG_1 = TAG_2 Then
        Range("E" & cols).Interior.ColorIndex = 0
        End If
      
        On Error Resume Next
        FromD_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), 8, False)
        On Error GoTo 0
        If FromD_1 <> FromD_2 Then
        Range("H" & cols).Interior.ColorIndex = 37
        End If
        If FromD_1 = FromD_2 Then
        Range("H" & cols).Interior.ColorIndex = 0
        End If
      
        On Error Resume Next
        ToD_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), 9, False)
        On Error GoTo 0
        If ToD_1 <> ToD_2 Then
        Range("I" & cols).Interior.ColorIndex = 37
        End If
        If ToD_1 = ToD_2 Then
        Range("I" & cols).Interior.ColorIndex = 0
        End If
      
        On Error Resume Next
        Voltage_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), 10, False)
        On Error GoTo 0
        If Voltage_1 <> Voltage_2 Then
        Range("J" & cols).Interior.ColorIndex = 37
        End If
        If Voltage_1 = Voltage_2 Then
        Range("J" & cols).Interior.ColorIndex = 0
        End If
      
        On Error Resume Next
        Length_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), 11, False)
        On Error GoTo 0
        If Length_1 <> Length_2 Then
        Range("K" & cols).Interior.ColorIndex = 37
        End If
        If Length_1 = Length_2 Then
        Range("K" & cols).Interior.ColorIndex = 0
        End If
      
        On Error Resume Next
        Size_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), 12, False)
        On Error GoTo 0
        If Size_1 <> Size_2 Then
        Range("L" & cols).Interior.ColorIndex = 37
        End If
        If Size_1 = Size_2 Then
        Range("L" & cols).Interior.ColorIndex = 0
        End If
      
        On Error Resume Next
        Cores_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), 13, False)
        On Error GoTo 0
        If Cores_1 <> Cores_2 Then
        Range("M" & cols).Interior.ColorIndex = 37
        End If
        If Cores_1 = Cores_2 Then
        Range("M" & cols).Interior.ColorIndex = 0
        End If
      
        On Error Resume Next
        Type_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), 14, False)
        On Error GoTo 0
        If Type_1 <> Type_2 Then
        Range("N" & cols).Interior.ColorIndex = 37
        End If
        If Type_1 = Type_2 Then
        Range("N" & cols).Interior.ColorIndex = 0
        End If
      
        On Error Resume Next
        Connection_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), 15, False)
        On Error GoTo 0
        If Connection_1 <> Connection_2 Then
        Range("O" & cols).Interior.ColorIndex = 37
        End If
        If Connection_1 = Connection_2 Then
        Range("O" & cols).Interior.ColorIndex = 0
        End If
      
        On Error Resume Next
        Comments_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), 16, False)
        On Error GoTo 0
        If Comments_1 <> Comments_2 Then
        Range("P" & cols).Interior.ColorIndex = 37
        End If
        If Comments_1 = Comments_2 Then
        Range("P" & cols).Interior.ColorIndex = 0
        End If
      
        On Error Resume Next
        REV_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), 17, False)
        On Error GoTo 0
        If REV_1 <> REV_2 Then
        Range("Q" & cols).Interior.ColorIndex = 37
        End If
        If REV_1 = REV_2 Then
        Range("Q" & cols).Interior.ColorIndex = 0
        End If
      
        On Error Resume Next
        REV_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), 17, False)
        On Error GoTo 0
        If REV_1 <> REV_2 Then
        Range("Q" & cols).Interior.ColorIndex = 37
        End If
        If REV_1 = REV_2 Then
        Range("Q" & cols).Interior.ColorIndex = 0
        End If
      
        On Error Resume Next
        Schematic_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), 18, False)
        On Error GoTo 0
        If Schematic_1 <> Schematic_2 Then
        Range("R" & cols).Interior.ColorIndex = 37
        End If
        If Schematic_1 = Schematic_2 Then
        Range("R" & cols).Interior.ColorIndex = 0
        End If
      
        On Error Resume Next
        Block_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), 19, False)
        On Error GoTo 0
        If Block_1 <> Block_2 Then
        Range("S" & cols).Interior.ColorIndex = 37
        End If
        If Block_1 = Block_2 Then
        Range("S" & cols).Interior.ColorIndex = 0
        End If
      
        'if a new cable is added the entire row is highlighted'
        'the code row by row checks that each cable number is in the previous revision'
        Dim xlRange As Range
        Dim xlCell As Range
        Dim valueToFind
        Dim count As Integer
        count = 0
        valueToFind = Cable_1
        Set xlRange = Worksheets(store1).Range("A7:S500")

        For Each xlCell In xlRange
            If xlCell.Value = valueToFind Then
            count = count + 1
            End If
        Next xlCell
        If count = 0 Then
            Rows(cols).Interior.ColorIndex = 37
        End If
      
        On Error Resume Next
        Cable_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), 7, False)
        On Error GoTo 0
      
        'same as before but in reverse. checking that every cable in the previous rev is in the current rev'
         'removed cables are recored on the removed cables tab'
      
        Code_2 = Worksheets(store1).Range("A" & cols)
        Dim xl2Range As Range
        Dim xl2Cell As Range
        Dim valueToFind2
        Dim count2 As Integer
        count2 = 0
        valueToFind2 = Code_2
        Set xl2Range = Range("A7:S500")

        For Each xl2Cell In xl2Range
            If xl2Cell.Value = valueToFind2 Then
            count2 = count2 + 1
            End If
        Next xl2Cell
        If count2 = 0 Then
            listing = listing + 1
            Dim prev_rev As String
            Dim c_rev As String
            prev_rev = Worksheets(store1).Name
            c_rev = ActiveSheet.Name
            Worksheets("Removed Cables").Range("B" & listing) = Cable_2 & "  From  " & prev_rev & "  To  " & c_rev
        End If

      
    'end of loop through each cable'
    Next cols
    'checks to see if the loop found any removed cables. if yes then a prompt will apear to let you know'
    If Worksheets("Removed Cables").Range("B2") <> " " Then
        MsgBox ("Some Cables Have Been Removed. Please Refer to the Removed Cables Sheet")
    End If


End Sub

 

[NdNoviceHlp]

Hi ap123 and Welcome to the Board! Maybe this code will work for you. HTH. Dave

Compare 2 workbooks and find the differences using Array

I am trying 2 compare 2 workbooks loops but it is taking time. I want to compare 2 workbooks and find the differences Colud you pleas help on this. Below is the code for loops Public Function ExcelCmp(firstFile, secondFile, resultFile) ' Declaring varaibles Dim objExcel1, objExcel2...

www.mrexcel.com

 

[johnnyL]

@ap123, The following is a shortened version of the code that you posted. Try it out and see if it yields the same result as the code you posted:

Sub Compare_Revision_MCC7021()
'
'   variable used to count the removed cables, used later'
    Dim listing     As Long
'
    Dim count       As Long
    Dim xlCell      As Range
    Dim xlRange     As Range
    Dim valueToFind
'
'   makes sure the button is only pushed when it is meant to be. simple check on the tab either side to make sure its the lastest Rev, and not the first'
      Rev_Number = Range("Z1")
        Next_Rev = Rev_Number + 1
    Previous_Rev = Rev_Number - 1
           store = ActiveSheet.Index - 1
          store1 = ActiveSheet.Index + 1
'
    If Worksheets(store1).Name <> "MCC7021 Rev " & Previous_Rev Then Exit Sub
    If Worksheets(store).Name = "MCC7021 Rev " & Next_Rev Then Exit Sub
'
    Set xlRange = Worksheets(store1).Range("A7:S500")
'
    listing = 1
    Worksheets("Removed Cables").Range("B2:B100") = " "
'
'   steps through the cables'
    For RowNumber = 7 To 500
'
'   ColumnB  ColumnC  ColumnD  ColumnE  ColumnF  ColumnG  ColumnH  ColumnI  ColumnJ  ColumnK  ColumnL  ColumnM  ColumnN   ColumnO    ColumnP  ColumnQ    ColumnR
'   -------  -------  -------  -------  -------  -------  -------  -------  -------  -------  -------  -------  -------   -------    -------  -------    -------
'   Area_1   WBS_1    From_1   TAG_1    Power_1  Cable_1  FromD_1  ToD_1   Voltage_1 Length_1 Size_1   Cores_1  Type_1  Connection_1  REV_1  Schematic_1 Block_1
'
'
        Cable_1 = Range("G" & RowNumber)
'
        'the following block of code:'
        'using the cable number it looks up the desired cable infomation in the previous revision and compares it to the current revision'
        'if it is not the same it will highlight it blue (colour 37), if it is the same it is set to unhighlighted'
        'The "on error" lines of code just make sure that the code dosnt break if the cable isnt found in the previous revision'
'
        For ColumnNumber = 2 To 19
            If ColumnNumber = 7 Then ColumnNumber = ColumnNumber + 1                                                            ' Skip 7 ie. Column G
'
            On Error Resume Next
''            This_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), ColumnNumber, False)
            This_2 = Application.WorksheetFunction.VLookup(Cable_1, xlRange, ColumnNumber, False)
            On Error GoTo 0
            If Cells(RowNumber, ColumnNumber) <> This_2 Then Cells(RowNumber, ColumnNumber).Interior.ColorIndex = 37
            If Cells(RowNumber, ColumnNumber) = This_2 Then Cells(RowNumber, ColumnNumber).Interior.ColorIndex = 0
        Next
'
'       if a new cable is added the entire row is highlighted'
'       the code row by row checks that each cable number is in the previous revision'
'
        count = 0
        valueToFind = Cable_1
'
        For Each xlCell In xlRange
            If xlCell.Value = valueToFind Then count = count + 1
        Next xlCell
'
        If count = 0 Then Rows(RowNumber).Interior.ColorIndex = 37
'
        On Error Resume Next
''        Cable_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), 7, False)
        Cable_2 = Application.WorksheetFunction.VLookup(Cable_1, xlRange, 7, False)
        On Error GoTo 0
'
'       same as before but in reverse. checking that every cable in the previous rev is in the current rev'
'       removed cables are recored on the removed cables tab'
'
        Dim c_rev       As String
        Dim prev_rev    As String
'
        count = 0
        valueToFind = Worksheets(store1).Range("A" & RowNumber)
'
''        For Each xl2Cell In xl2Range
        For Each xlCell In xlRange
            If xlCell.Value = valueToFind Then count = count + 1
        Next xlCell
'
        If count = 0 Then
            listing = listing + 1
            prev_rev = Worksheets(store1).Name
            c_rev = ActiveSheet.Name
            Worksheets("Removed Cables").Range("B" & listing) = Cable_2 & "  From  " & prev_rev & "  To  " & c_rev
        End If
'
'   end of loop through each cable'
    Next RowNumber
'
'   checks to see if the loop found any removed cables. if yes then a prompt will apear to let you know'
    If Worksheets("Removed Cables").Range("B2") <> " " Then
        MsgBox ("Some Cables Have Been Removed. Please Refer to the Removed Cables Sheet")
    End If
End Sub

 

[ap123]

@ap123, The following is a shortened version of the code that you posted. Try it out and see if it yields the same result as the code you posted:

Sub Compare_Revision_MCC7021()
'
'   variable used to count the removed cables, used later'
    Dim listing     As Long
'
    Dim count       As Long
    Dim xlCell      As Range
    Dim xlRange     As Range
    Dim valueToFind
'
'   makes sure the button is only pushed when it is meant to be. simple check on the tab either side to make sure its the lastest Rev, and not the first'
      Rev_Number = Range("Z1")
        Next_Rev = Rev_Number + 1
    Previous_Rev = Rev_Number - 1
           store = ActiveSheet.Index - 1
          store1 = ActiveSheet.Index + 1
'
    If Worksheets(store1).Name <> "MCC7021 Rev " & Previous_Rev Then Exit Sub
    If Worksheets(store).Name = "MCC7021 Rev " & Next_Rev Then Exit Sub
'
    Set xlRange = Worksheets(store1).Range("A7:S500")
'
    listing = 1
    Worksheets("Removed Cables").Range("B2:B100") = " "
'
'   steps through the cables'
    For RowNumber = 7 To 500
'
'   ColumnB  ColumnC  ColumnD  ColumnE  ColumnF  ColumnG  ColumnH  ColumnI  ColumnJ  ColumnK  ColumnL  ColumnM  ColumnN   ColumnO    ColumnP  ColumnQ    ColumnR
'   -------  -------  -------  -------  -------  -------  -------  -------  -------  -------  -------  -------  -------   -------    -------  -------    -------
'   Area_1   WBS_1    From_1   TAG_1    Power_1  Cable_1  FromD_1  ToD_1   Voltage_1 Length_1 Size_1   Cores_1  Type_1  Connection_1  REV_1  Schematic_1 Block_1
'
'
        Cable_1 = Range("G" & RowNumber)
'
        'the following block of code:'
        'using the cable number it looks up the desired cable infomation in the previous revision and compares it to the current revision'
        'if it is not the same it will highlight it blue (colour 37), if it is the same it is set to unhighlighted'
        'The "on error" lines of code just make sure that the code dosnt break if the cable isnt found in the previous revision'
'
        For ColumnNumber = 2 To 19
            If ColumnNumber = 7 Then ColumnNumber = ColumnNumber + 1                                                            ' Skip 7 ie. Column G
'
            On Error Resume Next
''            This_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), ColumnNumber, False)
            This_2 = Application.WorksheetFunction.VLookup(Cable_1, xlRange, ColumnNumber, False)
            On Error GoTo 0
            If Cells(RowNumber, ColumnNumber) <> This_2 Then Cells(RowNumber, ColumnNumber).Interior.ColorIndex = 37
            If Cells(RowNumber, ColumnNumber) = This_2 Then Cells(RowNumber, ColumnNumber).Interior.ColorIndex = 0
        Next
'
'       if a new cable is added the entire row is highlighted'
'       the code row by row checks that each cable number is in the previous revision'
'
        count = 0
        valueToFind = Cable_1
'
        For Each xlCell In xlRange
            If xlCell.Value = valueToFind Then count = count + 1
        Next xlCell
'
        If count = 0 Then Rows(RowNumber).Interior.ColorIndex = 37
'
        On Error Resume Next
''        Cable_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), 7, False)
        Cable_2 = Application.WorksheetFunction.VLookup(Cable_1, xlRange, 7, False)
        On Error GoTo 0
'
'       same as before but in reverse. checking that every cable in the previous rev is in the current rev'
'       removed cables are recored on the removed cables tab'
'
        Dim c_rev       As String
        Dim prev_rev    As String
'
        count = 0
        valueToFind = Worksheets(store1).Range("A" & RowNumber)
'
''        For Each xl2Cell In xl2Range
        For Each xlCell In xlRange
            If xlCell.Value = valueToFind Then count = count + 1
        Next xlCell
'
        If count = 0 Then
            listing = listing + 1
            prev_rev = Worksheets(store1).Name
            c_rev = ActiveSheet.Name
            Worksheets("Removed Cables").Range("B" & listing) = Cable_2 & "  From  " & prev_rev & "  To  " & c_rev
        End If
'
'   end of loop through each cable'
    Next RowNumber
'
'   checks to see if the loop found any removed cables. if yes then a prompt will apear to let you know'
    If Worksheets("Removed Cables").Range("B2") <> " " Then
        MsgBox ("Some Cables Have Been Removed. Please Refer to the Removed Cables Sheet")
    End If
End Sub

Thanks so much for your help. The code works when inserting a cable however it doesn't appear to register the removal of a cable.

 

[ap123]

Thanks so much for your help. The code works when inserting a cable however it doesn't appear to register the removal of a cable.

The code doesn't register the cable removed in the removed cables worksheet. But apart from that thanks so so much

 

[johnnyL]

Does it register the cable removed in the original code you posted?

 

[johnnyL]

I think I see a potential issue:

Sub Compare_Revision_MCC7021()
'
'   variable used to count the removed cables, used later'
    Dim listing     As Long
'
    Dim count       As Long
    Dim xlCell      As Range
    Dim xlRange     As Range
    Dim valueToFind
'
'   makes sure the button is only pushed when it is meant to be. simple check on the tab either side to make sure its the lastest Rev, and not the first'
      Rev_Number = Range("Z1")
        Next_Rev = Rev_Number + 1
    Previous_Rev = Rev_Number - 1
           store = ActiveSheet.Index - 1
          store1 = ActiveSheet.Index + 1
'
    If Worksheets(store1).Name <> "MCC7021 Rev " & Previous_Rev Then Exit Sub
    If Worksheets(store).Name = "MCC7021 Rev " & Next_Rev Then Exit Sub
'
    Set xlRange = Worksheets(store1).Range("A7:S500")
'
    listing = 1
    Worksheets("Removed Cables").Range("B2:B100") = " "
'
'   steps through the cables'
    For RowNumber = 7 To 500
'
'   ColumnB  ColumnC  ColumnD  ColumnE  ColumnF  ColumnG  ColumnH  ColumnI  ColumnJ  ColumnK  ColumnL  ColumnM  ColumnN   ColumnO    ColumnP  ColumnQ    ColumnR
'   -------  -------  -------  -------  -------  -------  -------  -------  -------  -------  -------  -------  -------   -------    -------  -------    -------
'   Area_1   WBS_1    From_1   TAG_1    Power_1  Cable_1  FromD_1  ToD_1   Voltage_1 Length_1 Size_1   Cores_1  Type_1  Connection_1  REV_1  Schematic_1 Block_1
'
'
        Cable_1 = Range("G" & RowNumber)
'
        'the following block of code:'
        'using the cable number it looks up the desired cable infomation in the previous revision and compares it to the current revision'
        'if it is not the same it will highlight it blue (colour 37), if it is the same it is set to unhighlighted'
        'The "on error" lines of code just make sure that the code dosnt break if the cable isnt found in the previous revision'
'
        For ColumnNumber = 2 To 19
            If ColumnNumber = 7 Then ColumnNumber = ColumnNumber + 1                                                            ' Skip 7 ie. Column G
'
            On Error Resume Next
''            This_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), ColumnNumber, False)
            This_2 = Application.WorksheetFunction.VLookup(Cable_1, xlRange, ColumnNumber, False)
            On Error GoTo 0
            If Cells(RowNumber, ColumnNumber) <> This_2 Then Cells(RowNumber, ColumnNumber).Interior.ColorIndex = 37
            If Cells(RowNumber, ColumnNumber) = This_2 Then Cells(RowNumber, ColumnNumber).Interior.ColorIndex = 0
        Next
'



'       if a new cable is added the entire row is highlighted'
'       the code row by row checks that each cable number is in the previous revision'
'
        count = 0
        valueToFind = Cable_1
'
        For Each xlCell In xlRange
            If xlCell.Value = valueToFind Then count = count + 1
        Next xlCell
'
        If count = 0 Then Rows(RowNumber).Interior.ColorIndex = 37
'
        On Error Resume Next
''        Cable_2 = Application.WorksheetFunction.VLookup(Cable_1, Worksheets(store1).Range("A7:S500"), 7, False)
        Cable_2 = Application.WorksheetFunction.VLookup(Cable_1, xlRange, 7, False)
        On Error GoTo 0
'
'       same as before but in reverse. checking that every cable in the previous rev is in the current rev'
'       removed cables are recored on the removed cables tab'
'
        Dim xl2Range    As Range
        Dim c_rev       As String
        Dim prev_rev    As String
'
        Set xl2Range = Range("A7:S500")
'
        count = 0
        valueToFind = Worksheets(store1).Range("A" & RowNumber)
'
''        For Each xl2Cell In xl2Range
        For Each xlCell In xl2Range
            If xlCell.Value = valueToFind Then count = count + 1
        Next xlCell
'
        If count = 0 Then
            listing = listing + 1
            prev_rev = Worksheets(store1).Name
            c_rev = ActiveSheet.Name
            Worksheets("Removed Cables").Range("B" & listing) = Cable_2 & "  From  " & prev_rev & "  To  " & c_rev
        End If
'
'   end of loop through each cable'
    Next RowNumber
'
'   checks to see if the loop found any removed cables. if yes then a prompt will apear to let you know'
    If Worksheets("Removed Cables").Range("B2") <> " " Then
        MsgBox ("Some Cables Have Been Removed. Please Refer to the Removed Cables Sheet")
    End If
End Sub

 

[ap123]

Thanks for your help

 

[johnnyL]

Did it work for you?

 

[ap123]

At first I thought it did. But then I looked down my table and there are blue cells which are highlighted when i haven't made changes to the sheet which is odd because the conditions state that if a cell is not in its previous revision then highlight blue