Insert Missing Dates By Comparing Two Lists Of Dates

[mahmoud-lee]

hi Welcome Please, I want to compare the two columns in terms of date, such as the existing columns

[princ_wns]

Hi Lee,

Can you please explain it bit more, what exactly you want.

:confused:

[mahmoud-lee]

I hope this will be explained

[mahmoud-lee]

This file may be explained

[Trebor76]

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):


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

Regards,

Robert

[mahmoud-lee]

I am unfortunately not the required solution
I want it like this solution and I hope by the formula

[Excel Fox]

Why is 2nd and 3rd January missing in first column?

[mahmoud-lee]

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

[Excel Fox]

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



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

[mahmoud-lee]

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

[Excel Fox]

The macro above gives this result. I am not sure how it is different from your Columns 3 & 4



1-Jan

1-Jan








1-Jan








1-Jan


2-Jan




3-Jan



4-Jan
4-Jan


4-Jan



4-Jan



4-Jan









5-Jan








6-Jan








7-Jan


8-Jan
8-Jan


8-Jan
8-Jan


8-Jan
8-Jan


8-Jan
0-Jan








9-Jan








9-Jan








9-Jan


12-Jan



12-Jan



12-Jan









13-Jan








13-Jan








13-Jan


15-Jan



16-Jan

[mahmoud-lee]

Yes, this is exactly what I want
But I want it by the formula
And very sorry for your trouble
I use (office 2003)

[aju.thomas]

Please check the below formula will help you

in column 3
=IFERROR(VLOOKUP(D4,$E$4:$E$19,1,0),TEXT(0,"General"))

in column 4
=IFERROR(VLOOKUP(E4,$D$4:$D$19,1,0),TEXT(0,"General"))

[Trebor76]

Please check the below formula will help you

It works until 8-Jan then stops. BTW there is an extra space between "a" and "l" for some reason that causes the formula to return #VALUE! errors.

I don't think you can do this via a formula. I could be wrong, but it needs a macro in my humble opinion.

Robert

[mahmoud-lee]

Unfortunately, I think it will not work on (OFFICE 2003)

[mahmoud-lee]

Thank you for your tired

[Trebor76]

Unfortunately, I think it will not work on (OFFICE 2003)

Why not try and find out?

[mahmoud-lee]

I have tried but did not work

[Trebor76]

Strange, they both worked for me :confused:

What error message(s) do you get when you run the either of code or what do you mean by it did not work?

[Admin]

@ Trebor76

IFERROR won't work in pre-2007 versions.

try this

=if(isnumber(match(D4,$E$4:$E$19,0)),VLOOKUP(D4,$E $4:$E$19,1,0),TEXT(0,"Genera l"))

[Trebor76]

@ Admin,

Yes I know ISERROR was released with 2007 (I didn't post that solution BTW).

Like the solution posted by aju.thomas, your solution again only works till 8-Jan and has an extra space between "a" and "l" in "General" (must be a formatting issue with the web page).

Robert

[mahmoud-lee]

Yes, it is working only until January 8, but do not come with the rest of the values

[Trebor76]

Perhaps if you post a file with one (or both) of the macros attached we can see why it's not working and advise accordingly.

[mahmoud-lee]

This is the file that you want to work examples
With a formula Mister Admin

[Trebor76]

The file didn't have either macro attached :confused:

Anyway, run the ExcelFox macro from the Macro dialog (opened via pressing and holding the Alt button followed by pressing the F8 key) on the data in Sheet2 to get the desired results.

HTH

Robert