Sub copy()

Dim Tube As String
Dim LastRow_ECAT As Integer
Dim LastRow_RIMS As Integer
Dim sShName As String, sAddress As String, vData

    Dim objCloseBook As Object
    
    Application.ScreenUpdating = False
    Workbooks.Open "https://terumoemea.sharepoint.com/sites/teamrooms/masterdatamanagement/eCatalogue/eProductCatalogue.xlsx"
    
    
    sAddress = "A1:I25000"
    
     vData = Sheets("Sheet1").Range(sAddress).Value
    ActiveWorkbook.Close False
    
    If IsArray(vData) Then
    
    Worksheets("E-Catalogue").Activate
        [A1].Resize(UBound(vData, 1), UBound(vData, 2)).Value = vData
    Else
        [A1] = vData
    End If
    
        'Workbooks.Open Filename:="https://terumoemea.sharepoint.com/sites/teamrooms/masterdatamanagement/eCatalogue/eProductCatalogue.xlsx"

LastRow_ECAT = Worksheets("E-catalogue").UsedRange.Rows.Count
LastRow_RIMS = Worksheets("RIMS active codes").UsedRange.Rows.Count

'MsgBox (LastRow_ECAT)

Worksheets("Comparison").Activate

Worksheets("Comparison").Range("A2:E100000").Clear

For i = 2 To LastRow_ECAT

Tube = Worksheets("E-catalogue").Cells(i, 2).Value

Set A = Worksheets("RIMS active codes").Columns(2).Find(Tube, LookIn:=xlValues)
    
        If A Is Nothing Then
            
            If Left(Tube, 3) = "CX-" Then
            
            'PS = Range("A" & Rows.Count).End(xlUp).Row

                Worksheets("Comparison").Cells(ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1, 1).Value = Tube
            Worksheets("Comparison").Cells(ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row, 2).Value = "New item. To add"
                
                Worksheets("Comparison").Cells(ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row, 3).Value = Worksheets("E-catalogue").Cells(i, 5).Value
                Worksheets("Comparison").Cells(ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row, 4).Value = Worksheets("E-catalogue").Cells(i, 7).Value
                Worksheets("Comparison").Cells(ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row, 5).Value = Worksheets("E-catalogue").Cells(i, 8).Value
                
            End If

       End If

Next i

For i = 6 To LastRow_RIMS

Tube = Worksheets("RIMS active codes").Cells(i, 2).Value

Set A = Worksheets("E-catalogue").Columns(2).Find(Tube, LookIn:=xlValues)
    

        If A Is Nothing Then
            
            'If Left(Tube, 3) = "CX-" Then

                Worksheets("Comparison").Cells(ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1, 1).Value = Tube
                Worksheets("Comparison").Cells(ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row, 2).Value = "Old item. Remove"
              
            
       End If

Next i

Columns("A:E").EntireColumn.AutoFit

    Cells(1, 6) = "Update : " & Now
    Cells(1, 6).Font.Bold = True
    Cells(1, 6).Font.Color = vbRed
  
Application.ScreenUpdating = True

End Sub