hi Welcome Please, I want to compare the two columns in terms of date, such as the existing columns
Printable View
hi Welcome Please, I want to compare the two columns in terms of date, such as the existing columns
Hi Lee,
Can you please explain it bit more, what exactly you want.
:confused:
I hope this will be explained
This file may be explained
Hi mahmoud-lee,
This is much harder than it seems - well it was for me anyway (took me nearly 3 days on and off).
Anyway, let us know how this goes (hopefully good as it works for me):
Regards,Code:Option Explicit
Sub Macro1()
'Written by Trebor76
'Visit my website www.excelguru.net.au
'Match the dates in Col's D and E and output them to Col's L and M respectively.
'http://www.excelfox.com/forum/f2/compare-between-two-dates-1497/
Const lngStartRow As Long = 4 'Starting row number for the data. Change to suit.
Dim objMyUniqueList As Object
Dim strMyArray() As String
Dim lngArrayCount As Long
Dim lngEndRow As Long
Dim lngListARow As Long, _
lngListBRow As Long
Dim rngCell As Range
Dim dteMyDate As Date
Dim varUniqueItem As Variant
Dim lngMatchCount As Long
Application.ScreenUpdating = False
Set objMyUniqueList = CreateObject("Scripting.Dictionary")
lngEndRow = Range("D:E").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'Create an unique array of dates from both columns.
For Each rngCell In Range("D" & lngStartRow & ":E" & lngEndRow)
If Len(rngCell) > 0 And IsDate(rngCell) = True Then
dteMyDate = CDate(rngCell)
If Not objMyUniqueList.Exists(dteMyDate) Then
objMyUniqueList.Add dteMyDate, dteMyDate
lngArrayCount = lngArrayCount + 1
ReDim Preserve strMyArray(1 To lngArrayCount)
strMyArray(lngArrayCount) = Format(dteMyDate, "yyyymmdd") 'Best format for sorting.
End If
End If
Next rngCell
'Need to sort the array in ascending sequence.
'This nifty code was written by Hans Vogelaar MCC, MVP and is sourced from here: _
'http://social.msdn.microsoft.com/Forums/en-US/830b42cf-8c97-4aaf-b34b-d860773281f7/sorting-an-array-in-vba-without-excel-function?forum=isvvba
Call BubbleSort(strMyArray)
'Initialise the 'lngListARow' and 'lngListBRow' variables to the 'lngStartRow' constant variable.
lngListARow = lngStartRow: lngListBRow = lngStartRow
For Each varUniqueItem In strMyArray()
'**Note the 'dteMyDate' variable here must be in the same format (i.e. with dashes or slashes) as the dates are formatted within the cells**
'Toggle through the unique dates and, using the COUNTIF function, output however many are required from Col. D into Col. L.
dteMyDate = CDate(Mid(varUniqueItem, 5, 2) & "-" & Right(varUniqueItem, 2) & "-" & Left(varUniqueItem, 4))
If Evaluate("COUNTIF($D$" & lngStartRow & ":$D$" & lngEndRow & ",""" & Format(dteMyDate, "d-mmm-yyyy") & """)") > 0 Then
For lngMatchCount = 1 To Evaluate("COUNTIF($D$" & lngStartRow & ":$D$" & lngEndRow & ",""" & Format(dteMyDate, "d-mmm-yyyy") & """)")
Cells(lngListARow, "L") = Format(CDate(dteMyDate), "mm/dd/yyyy") 'Output format can be changed here if desired.
lngListARow = lngListARow + 1
Next lngMatchCount
End If
'Toggle through the unique dates and, using the COUNTIF function, output however many are required from Col. E into Col. M.
If Evaluate("COUNTIF($E$" & lngStartRow & ":$E$" & lngEndRow & ",""" & Format(dteMyDate, "d-mmm-yyyy") & """)") > 0 Then
For lngMatchCount = 1 To Evaluate("COUNTIF($E$" & lngStartRow & ":$E$" & lngEndRow & ",""" & Format(dteMyDate, "d-mmm-yyyy") & """)")
Cells(lngListBRow, "M") = Format(CDate(dteMyDate), "mm/dd/yyyy") 'Output format can be changed here if desired.
lngListBRow = lngListBRow + 1
Next lngMatchCount
End If
'Get the two output row numbers in sync.
If lngListARow > lngListBRow Then
lngListBRow = lngListARow
ElseIf lngListBRow > lngListARow Then
lngListARow = lngListBRow
End If
Next varUniqueItem
'Remove objects from memory
Set objMyUniqueList = Nothing
Erase strMyArray()
Application.ScreenUpdating = True
MsgBox "The dates in columns D and E have matched to columns L and M.", vbInformation, "Excel Guru"
End Sub
Sub BubbleSort(arr)
Dim strTemp As String
Dim i As Long
Dim j As Long
Dim lngMin As Long
Dim lngMax As Long
lngMin = LBound(arr)
lngMax = UBound(arr)
For i = lngMin To lngMax - 1
For j = i + 1 To lngMax
If arr(i) > arr(j) Then
strTemp = arr(i)
arr(i) = arr(j)
arr(j) = strTemp
End If
Next j
Next i
End Sub
Robert
I am unfortunately not the required solution
I want it like this solution and I hope by the formula
Why is 2nd and 3rd January missing in first column?
Nothing
But I mean, any date that does not exist in the corresponding column writing (0) in the corresponding date
But when it is writing again ...... etc.
Because it is a comparison between columns (1) & (2)
I want them to like 3, 4
What do you mean nothing?
All the attachments you are uploading are exactly the same, and you are not proving anything that way. My question is, why is 2nd and 3rd January missing in your final output?
If that was a mistake from your part, then try this code
Code:Sub ExcelFox()
Dim lng As Long: lng = 4
While Not (IsEmpty(Range("D" & lng).Value) Or IsEmpty(Range("E" & lng).Value))
If Range("D" & lng).Value > Range("E" & lng).Value Then
Range("D" & lng).Insert xlDown
ElseIf Range("D" & lng).Value < Range("E" & lng).Value Then
Range("E" & lng).Insert xlDown
End If
lng = lng + 1
Wend
End Sub
I am very sorry
But I want to convert columns (1) & (2)
Such as columns (3) & (4)
It remains Columns (1) & (2)
I wish formulas and not code