To change Date format in a disorderly column

**pmich** · 06-04-2014, 04:03 PM

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.

Code:

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** · 06-04-2014, 05:34 PM

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

**pmich** · 06-05-2014, 10:24 AM

DateReorganizeTrial.xls
Expecting your valuable suggestion.

**p45cal** · 06-07-2014, 03:16 AM

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** · 06-09-2014, 12:39 PM

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** · 06-09-2014, 03:50 PM

Code:

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

**pmich** · 06-09-2014, 04:21 PM

Originally Posted by snb

Code:

Sub M_snb()
    [K2:K200] = [if(B2:B200="","",if(isnumber(B2:B200),B2:B200,date(right(trim(B2:B200),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** · 06-09-2014, 11:23 PM

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:

Code:

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:

Code:

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** · 06-10-2014, 02:28 AM

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

Code:

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(substitute(B2:B200,"`",""),2),"/",""),date(right(trim(B2:B200),4),substitute(mid(B2:B200,search("/",B2:B200)+1,2),"/",""),substitute(left(substitute(B2:B200,"`",""),2),"/",""))))]
End Sub

**pmich** · 06-10-2014, 01:47 PM

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.