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
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
Yes, this is exactly what I want
But I want it by the formula
And very sorry for your trouble
I use (office 2003)
Please check the below formula will help you
in column 3
=IFERROR(VLOOKUP(D4,$E$4:$E$19,1,0),TEXT(0,"Genera l"))
in column 4
=IFERROR(VLOOKUP(E4,$D$4:$D$19,1,0),TEXT(0,"Genera l"))
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.Quote:
Please check the below formula will help you
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
Unfortunately, I think it will not work on (OFFICE 2003)
Thank you for your tired
Why not try and find out?Quote:
Unfortunately, I think it will not work on (OFFICE 2003)
I have tried but did not work
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?
@ 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"))
@ 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
Yes, it is working only until January 8, but do not come with the rest of the values
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.
This is the file that you want to work examples
With a formula Mister Admin
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