Match and reflect the latest time

Question

I can do this

We have 2 worksheets, (User_1) and (User_2)

Each worksheet has 3 columns, [A] System_ID, [B] User Comment, and [C] Last Modified Time

1- The logic matches Column [A] in both sheets, if they match then _

2- Check Last Modified Time in Column [C], column(a).offset(0,2).value then _

3- the greatest or latest time wins, by getting Comment in Column [B], column(a).offset(0,1).value then _

4- Overwrite in the other User_# Worksheet comment in Column [B]

I need to do this
Convert (For each - loop) to arrays, for performance sake.
The real ranges are much bigger than in this example.

Code to convert to array:

Sub Get_LastModified_Here()

    ' Specify Both Worksheets   
    Dim Location1 As Workbook
    Set Location1 = GetWorkbook("C:\Users\HP\Desktop\User_1.xlsb")

    Dim Location2 As Workbook
    Set Location2 = GetWorkbook("C:\Users\HP\Desktop\User_2.xlsb")

    ' Set User_2 Worksheet 
    Dim SourceCell, SourceRange As Range

    ' This is the primary key (system_id)
    Set SourceRange = Workbooks("User_2.xlsb").Sheets("Data").Range("A2:" & "A4")

    ' Start Loop
    For Each SourceCell In SourceRange ' for each cell in system_id column in user_2 worksheet

        Dim X As String ' get each cell address for later usage
        X = SourceCell.Address

        ' Set User_1 Worksheet  (this worksheet)
        Dim TargetCell As Excel.Range
        Set TargetCell = Workbooks("User_1.xlsb").Worksheets("Data").Range(X)    

        ' If column A in both sheets match (System_Unique_ID)
        If SourceCell = TargetCell Then
                
            ' If user 2 (source) modified date in col (C) is (later than >) user1 (target) modified date in col (C) then user 1 comment in col (b) is overwritten by user 2 comment in col (b)   
            If SourceCell.Offset(0, 2).Value > TargetCell.Offset(0, 2).Value Then
                TargetCell.Offset(0, 1).Value = SourceCell.Offset(0, 1).Value
                    
            ' Else if user 1 modified last then his/her comment wins and overwrite user 2 comment
            ElseIf SourceCell.Offset(0, 2).Value < TargetCell.Offset(0, 2).Value Then
                SourceCell.Offset(0, 1).Value = TargetCell.Offset(0, 1).Value

            End If
        End If
    Next SourceCell

End Sub

Functions Module / not related

Public Function GetWorkbook(ByVal sFullName As String) As Workbook
    
    Dim sFile As String
    Dim wbReturn As Workbook
    
    sFile = Dir(sFullName)
    
    On Error Resume Next
    Set wbReturn = Workbooks(sFile)
    
    If wbReturn Is Nothing Then
        Set wbReturn = Workbooks.Open(sFullName)
    End If
    On Error GoTo 0
    
    Set GetWorkbook = wbReturn
    
End Function

I am sorry what do you mean? (x) represents the address to be used in target sheet based on address in source sheet — Zatary, Dec 05 '20 at 04:21
`Set TargetCell = Workbooks("User_1.xlsb").Worksheets("Data").Range(X)` What is the value of X? — Dy.Lee, Dec 05 '20 at 05:35
[This](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba?rq=1) There is important information about the arrangement. — Dy.Lee, Dec 05 '20 at 05:40

score 2 · Accepted Answer · answered Dec 05 '20 at 06:03

Try,

Sub Get_LastModified_Here()

    ' Specify Both Worksheets
    Dim Location1 As Workbook
    Set Location1 = GetWorkbook("C:\Users\HP\Desktop\User_1.xlsb")

    Dim Location2 As Workbook
    Set Location2 = GetWorkbook("C:\Users\HP\Desktop\User_2.xlsb")

    ' Set User_2 Worksheet
    Dim SourceCell As Range, SourceRange As Range
    Dim rngTarget As Range
    Dim strAdr As String
    Dim vSource As Variant, vTarget As Variant
    Dim i As Long
    ' This is the primary key (system_id)
    Set SourceRange = Workbooks("User_2.xlsb").Sheets("Data").Range("A2:" & "A4")
    
    'The range is expanded by two columns.
    With SourceRange
        Set SourceRange = .Resize(.Rows.Count, .Columns.Count + 2)
    End With
    
    strAdr = SourceRange.Address
    Set rngTarget = Workbooks("User_1.xlsb").Worksheets("Data").Range(strAdr)
    
    'Bring the range as a two-dimensional array.
    vSource = SourceRange
    vTarget = rngTarget
    
    ' Start Loop
   'For Each SourceCell In SourceRange ' for each cell in system_id column in user_2 worksheet
    For i = 1 To UBound(vSource, 1)
        'Dim X As String ' get each cell address for later usage
        'X = SourceCell.Address

    
        ' Set User_1 Worksheet  (this worksheet)
        'Dim TargetCell As Excel.Range
       ' Set TargetCell = Workbooks("User_1.xlsb").Worksheets("Data").Range(X)

        ' If column A in both sheets match (System_Unique_ID)
        'If SourceCell = TargetCell Then
         If vSource(i, 1) = vTarget(i, 1) Then
            ' If user 2 (source) modified date in col (C) is (later than >) user1 (target) modified date in col (C) then user 1 comment in col (b) is overwritten by user 2 comment in col (b)
            'If SourceCell.Offset(0, 2).Value > TargetCell.Offset(0, 2).Value Then
             If vSource(i, 3) > vTarget(i, 3) Then
                    'TargetCell.Offset(0, 1).Value = SourceCell.Offset(0, 1).Value
                    vTarget(i, 2) = vSource(i, 2)
            'Else if user 1 modified last then his/her comment wins and overwrite user 2 comment
            'ElseIf SourceCell.Offset(0, 2).Value < TargetCell.Offset(0, 2).Value Then
            ElseIf vSource(i, 3) < vTarget(i, 3) Then
                'SourceCell.Offset(0, 1).Value = TargetCell.Offset(0, 1).Value
                vSource(i, 2) = vTarget(i, 2)
            End If
        End If
    'Next SourceCell
    Next i
    
    'Assign the values of the array to the range.
    SourceRange = vSource
    rngTarget = vTarget
End Sub

thanks a lot for giving me some of your time and for sharing your experience. I really appreciate it, thank you very much Good luck :D — Zatary, Dec 05 '20 at 07:39
I have just noticed that matching cells in column A only works if both cells have the same address, is there a way to match both cells even if they don't have the same order. Thanks in advance — Zatary, Dec 09 '20 at 15:55

Match and reflect the latest time

1 Answers1