To change Date format in a disorderly column

[pmich]

The dates in date column are entered like this.
01/03/2011
01/04/2011
01/06/2011
01/12/2011
13/1/2011
14/1/2011
19/1/2011
29/1/2011
31/1/2011
02/01/2011
02/03/2011
02/04/2011
02/08/2011
09/02/2011
02/10/2011
02/11/2011
14/2/2011
28/2/2011
03/01/2011

In the above example I have given as though one date occurs only one. But, one date may be repeated more than once.

From 01/03/2011 to 01/12/2011 refers to Jan. (mm/dd/yyyy)
From 13/1/2011 to 31/1/2011 refers to Jan. (dd/mm/yyyy)
Then,
From 02/01/2011 to 02/08/2011 refers to Feb. (mm/dd/yyyy)
Then 09/02/2011 refers to Feb. (dd/mm/yyyy)
From 02/10/2011 to 02/11/2011 refers to Feb. (mm/dd/yyyy)
From 14/2/2011 to 28/2/2011 refers to Feb. (dd/mm/yyyy)
Then,
From 03/01/2011 refers to Mar. (mm/dd/yyyy)

After this, dates of April are mentioned.
Likewise, until December dates are keyed in.
After December, the next year begins.
Again the date format is not uniform in that year.
Thus it goes on upto 2014.

There is no uniformity in the format.
The date format does not change after say, a particular row.
Months are noted down as 01 and also 1.

I have written the code given below. it works fine for 5 months.
But is there a simpler method or how to simplify this code?
Please suggest.


Private Sub UserForm_Click()
Dim rRng As Range
Dim rCell As Range
Dim sDest As String
Dim sYear, sMonth, sDay, aDate
Dim LastRecNum As Long
Sheets("MemberJoinDate").Select
On Error Resume Next
Sheets("MemberJoinDate").AutoFilterMode = False
On Error GoTo 0
Dim Bgnrow As Long
Dim Endrow As Long
Dim Mnth As Integer
Endrow = 0
ChkAgain:
If Endrow = 0 Then
Bgnrow = 2
Endrow = 73
Mnth = 1
ElseIf Endrow = 73 Then
Bgnrow = 74
Endrow = 150
Mnth = 2
ElseIf Endrow = 150 Then
Bgnrow = 151
Endrow = 219
Mnth = 3
ElseIf Endrow = 219 Then
Bgnrow = 220
Endrow = 301
Mnth = 4
ElseIf Endrow = 301 Then
Bgnrow = 302
Endrow = 405
Mnth = 5
End If
Set rRng = ActiveSheet.Range("B" & Trim(Str(Bgnrow)) & ":B" & Trim(Str(Endrow)))
sDest = "D"
For Each rCell In rRng.Cells
sYear = 99999
If InStr(rCell.Value, "/") > 0 Then
aDate = Split(rCell.Value, "/")
If UBound(aDate) = 2 Then
If aDate(0) <= 12 Then
If Val(aDate(0)) = Mnth Then
sDay = aDate(1)
sMonth = aDate(0)
ElseIf Val(aDate(0)) > Mnth And Val(aDate(1)) = Mnth Then
sDay = aDate(0)
sMonth = aDate(1)
ElseIf Val(aDate(0)) < Mnth And Val(aDate(1)) = Mnth Then
sDay = aDate(0)
sMonth = aDate(1)
End If
ElseIf aDate(0) >= 12 Then
If Val(aDate(0)) > Mnth And Val(aDate(1)) = Mnth Then
sDay = aDate(0)
sMonth = aDate(1)
End If
End If
sYear = aDate(2)
End If
End If
With rCell.Range(sDest & "1")
If sYear <> 99999 Then
On Error Resume Next
.Value = "'" & Format(CDate(sDay & "/" & sMonth & "/" & sYear), "DD-MM-YYYY")
If Err.Number <> 0 Then .Value = rCell.Value
On Error GoTo 0
Else
.Value = rCell.Value
End If
End With
Next
If Endrow = 876 Then
Exit Sub
End If
GoTo ChkAgain
End Sub

Sample of the result I get is given below:
03-01-2011
04-01-2011
07-01-2011
10-01-2011
11-01-2011
29-01-2011
31-01-2011
01-02-2011
09-02-2011
15-02-2011
28-02-2011
01-03-2011
09-03-2011
14-03-2011
31-03-2011
01-04-2011
09-04-2011
11-04-2011
19-04-2011
20/4/20 11
29-04-2011
30-04-2011
02-05-2011
02-05-2011
05-05-2011
06-05-2011
09-05-2011
10-05-2011
28-05-2011
30-05-2011
31-05-2011

Is it possible to get the result as : 03/01/2011 instead of 03-01-2011? Please suggest.

[Excel Fox]

Yes, this is possible. Can you post a sample file?

[pmich]

1614
Expecting your valuable suggestion.

[p45cal]

I suspect this is happening because you are importing or copy/pasting the data from somewhere else into Excel.
Excel is being 'helpful' by trying to convert dates into real excel dates as the import/paste is carried out. It's making assumptions about the months and days, that is it's assuming that the dates are mm/dd/yy until an impossible month greater than 12 occurs.
One thing you can do to prevent Excel from doing this is to format the cells you're copying to as TEXT before pasting the dates. Then you'll be able to use a trick with Text to Columns to convert the dates to real dates (everything remains in the same single column)
Another way depends on how you're importing the text - you will probably be able to tell Excel the date format as you're importing.

So the questions arise:
1. Is this indeed caused by getting the dates etc. from somewhere else?
2. If so how are you currently importing the data and from where?

[pmich]

Thanks for the reply.
This is not caused by getting the dates from somewhere else.
The column is actual data entry by various persons.
Thanks for your suggestion. I will try your suggestion.
Anyway, I have my long code. If nothing works out, I will use my long code.
Thanks for taking your time. If there is a way to simplify my long code, and if you can suggest me that, I will appreciate it.

[snb]

Sub M_snb()
[K2:K200] = [if(B2:B200="","",if(isnumber(B2:B200),B2:B200,date(right(trim(B2:B 200),4),substitute(mid(B2:B200,search("/",B2:B200)+1,2),"/",""),substitute(left(substitute(B2:B200,"`",""),2),"/",""))))]
End Sub

[pmich]

Sub M_snb()
[K2:K200] = [if(B2:B200="","",if(isnumber(B2:B200),B2:B200,date(right(trim(B2:B 200),4),substitute(mid(B2:B200,search("/",B2:B200)+1,2),"/",""),substitute(left(substitute(B2:B200,"`",""),2),"/",""))))]
End Sub
Thanks for the quick reply.
It changes dates into numbers. Afterwards I formatted the cells manually as DD/MM/YYYY.
After 31/1/2011, the date 02/01/2011 remains as it is. It should be changed as 01/02/2011.
Similarly, after 09/02/2011, the date 02/10/2011 remains as it is. It should be changed as 10/02/2011.

[p45cal]

It looks like your data is in date order when sorted on column A or C (SINo or MemNo), so I'm going to assume it is.
I see from your code (the setting of BgnRow and EndRow) that you've already determined what month each row belongs to, and that this is a manual process. I understand why you need to do this as taking any given date by itself it is impossible to tell whether the date is dd/mm/yyyy or mm/dd/yyyy unless the mm and dd are both the same or one of them is greater than 12, in which case that one's the dd value. Also it's not beyond imagination that even with multiple dates it can still be impossible to determine the date formats; take:
30/3/2011
5/4/2011
5/4/2011
25/5/2011
While it's clear the first date is March 30th 2011, and the last date is May 25th 2011, it's impossible to determine whether the two similar-looking dates in the middle are May 4th 2011 or April 5th 2011, or even if they are both the same date!
Now I could write code to look at the unambiguous dates above and below dates where you are unsure of their format, but that could get complicated and I don't want to do it. So I'm go to suggest a two part process. The code is written for your sample sheet where it looks like you want your definitive date to be two columns to the right of the existing ambiguous dates.
Before running the codes, you should make sure that you've selected the dates in column B that you want to process (in your sample file this was B2:B52).
Part 1:
Sub blah()
Selection.Offset(, 2).NumberFormat = ""
For Each cll In Selection.Cells
If IsDate(cll.Value) Then
xx = Split(cll.Value, "/")
If Application.Max(xx(0), xx(1)) > 12 Or Val(xx(0)) = Val(xx(1)) Then
cll.Offset(, 2) = Application.Min(xx(0), xx(1))
Else
cll.Offset(, 2) = Val(xx(0)) & " or " & Val(xx(1))
End If
Else
cll.Offset(, 2) = "check"
End If
Next cll
End Sub

The above code tries to put a definitive month number in column D. It will know what the month number is if a number greater that 12 appears in a section of the date which is not the year, or if those numbers are both the same. If it can't decide what the month number is, it will but both values in that cell (eg. 4 or 8) or if it can't make head or tail of the date it will put the word check in that cell.

Now for the manual intervention. I'll do this using your sample file. After running the code the first thing to do is to look for any instances of check in column D and rectify the corresponding dates in column B, after which, run the above code again makig sure there are no more instances of check in column D.
I ran the above code on your file and the first row to have a definite month in was row 11, and that was 1 (Jan) and the year was 2011. Rows 2 to 10 had variously: 1 or 3, 1 or 3, 1 or 4, 1 or 6 etc. The thing that was common to all of them was that they all had a 1 in them so already it was looking likely that they might all be 1. They were all 2011 and the first row below them with a definite date was also January, so it became certain that they were all January. So in preparation for the next part of code we have to replace what's in cells D2:D10 with a 1. This is quickly done by selecting those cells, entering 1 on the keyboard, holding down the Ctrl key and presing Enter. Job done.
You can go through just the same process with D18:D26. Other cells might need to take other factors into account, but it should be fairly easy and quick to do.

Once you have just the numbers 1 to 12 in column D it's time to run Part 2 of the code, so after selecting the dates again (B2:B52) run:
Sub blah2()
For Each cll In Selection.Cells
xx = Empty
If IsDate(cll.Value) Then
xx = Split(cll.Value, "/")
cll.Offset(, 2).Value = DateSerial(Val(xx(2)), cll.Offset(, 2).Value, IIf(Val(xx(0)) = cll.Offset(, 2).Value, Val(xx(1)), Val(xx(0))))
Else
cll.Offset(, 2).Value = "check"
End If
Next cll
'Selection.Offset(, 2).NumberFormat = "dd/mmm/yyyy" 'debug line to be replaced with line below
Selection.Offset(, 2).NumberFormat = "dd/mm/yyyy"
End Sub
This will replace the month numbers in column D with real Excel dates, formatted as you seem to want them by the last line of the above code.

Any use?

[snb]

If you analyse the code and understand how it works it's easy to amend.


Sub M_snb()
[K2:K200] = [if(B2:B200="","",if(isnumber(B2:B200),date(substitute(mid(B2:B200, search("/",B2:B200)+1,2),"/",""),right(trim(B2:B200),4),substitute(left(substitut e(B2:B200,"`",""),2),"/",""),date(right(trim(B2:B200),4),substitute(mid(B2:B2 00,search("/",B2:B200)+1,2),"/",""),substitute(left(substitute(B2:B200,"`",""),2),"/",""))))]
End Sub

[pmich]

p45cal,
Thanks for the fill in tip:
"To replace what's in cells D2:D10 with a 1 is quickly done by selecting those cells, entering 1 on the keyboard, holding down the Ctrl key and pressing Enter."
I never knew before. Very useful.

Your code 1 and code 2 are great. The job is done like that. Fantastic. I tried in my sample file. I am going to try it in the main file.
I was actually re-writing my code with nested IFs. After trying your codes, I stopped writing the nested IFs.
Thanks a lot.

You have given clear guidelines to use your codes. Thanks for the same.

You asked 'ANY USE'? Oh, really useful.
I had to work on more than 4000 records. You saved my time.
Thanks once again.

[pmich]

snb,
Thanks for taking time to reply me with your code. I do appreciate. The codes given by p45cal did the job.
I may use the logic in your code, for some other purpose. Yes, no effort will go waste. I am learning and your code helps. Thanks.