Compare cell with a previous one in the same column- VBA-CodePudding

I have the data in excel like this, one column:

10/15/2021  7:59:42 AM
10/15/2021  7:59:44 AM
10/15/2021  7:59:46 AM
.
.
.
10/16/2021  7:59:42 AM
10/16/2021  7:59:48 AM
10/16/2021  7:59:49 AM

I used this code in VBA to create two columns, one with date and one with time:

Sub CommandButton1_Click()
    Dim rng As Range
    Set rng = [A1]
    Set rng = Range(rng, Cells(Rows.Count, rng.Column).End(xlUp))

    rng.Texttocolumns Destination:=[B1], DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, xlMDYFormat), Array(2, xlMDYFormat), Array(3, xlGeneralFormat)), _
    TrailingMinusNumbers:=True
    
    Columns("C").Delete
    Columns("E").Delete
    Columns("D").Delete
    
End Sub

After that, I have two columns. My goal is to have one column with date and time, but to have date only for the first time when it appears. I have done this with excel using IF and later CONCAT. I copied first row and for the second I used:

IF(B3=B2,"",B3)

The result is empty cell, I just then use CONCAT with row which contains time. I would love to do this in VBA, but I am not sure how.

CodePudding user response：

Please, try the next way. It will process the initial column, without splitting it by columns. It assumes that the column keeping the Date is "A:A". It should be very fast for larger ranges, using arrays and working in memory. It will return the processed array in column "B:B", starting from the second row (in the first one I assumed a header should be):

Sub keepFirstDateOnly_Date()
  Dim sh As Worksheet, lastR As Long, arrD, arrFin
  Dim firstD As String, i As Long, j As Long
  
  Set sh = ActiveSheet
  lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
  arrD = sh.Range("A2:A" & lastR).Value2
  ReDim arrFin(1 To UBound(arrD), 1 To 1)
  For i = 1 To UBound(arrD)
     arrFin(i, 1) = Format(arrD(i, 1), "mm/dd/yyyy hh:mm:ss AM/PM")
     Do While DateSerial(Year(arrD(i   j, 1)), month(arrD(i   j, 1)), Day(arrD(i   j, 1))) = _
                              DateSerial(Year(arrD(i, 1)), month(arrD(i, 1)), Day(arrD(i, 1)))
        j = j   1: If i   j >= UBound(arrD) Then Exit Do
        arrFin(i   j, 1) = Format(TimeValue(CDate(arrD(i   j, 1))), "hh:mm:ss AM/PM")
     Loop
     i = i   j - 1: j = 0
  Next i
  sh.Range("B2").Resize(UBound(arrFin), 1).value = arrFin
End Sub

It works only if the range to be processed if formatted As Date, as you stated.

Please, test it and send some feedback.

The same suggestion to change "B2" with "A2" if you like the result in B:B, to make it overwriting the A:A existing content.