Why are my dates not changing when im formatting cells.

ghrek

Board Regular
Joined
Jul 29, 2005
Messages
231
Hi I have a workbook that I have formatted the cells in date format to dd/mm/yyyy . The issue im having is that some are not transferring into new format. Ive tried to format cells again but nothing happening

its happening from line 4 onwards. shows 07/06/2020 when it should be 06/07/2020 .

Not that it shows on the table below the normal dates are listed to the left and the non normal to the right of the cell. See the PNG file




Any ideas why this happening

29191485b (2).xlsm
ABCDE
22395637320/07/2020£0.00MISSING FROM STN
32395637429/06/2020£0.00MISSING FROM STN
42395637407/06/2020£0.00MISSING FROM STN
52408629307/02/2020£32.50MISSING FROM STN
62408629307/03/2020£29.20MISSING FROM STN
72408629307/04/2020£20.25MISSING FROM STN
82408629307/05/2020£77.30MISSING FROM STN
92408629307/06/2020£54.60MISSING FROM STN
102408629307/07/2020£34.00MISSING FROM STN
112408629307/08/2020£59.90MISSING FROM STN
122408629307/09/2020£26.50MISSING FROM STN
Sheet3
 

Attachments

  • Untitled.png
    Untitled.png
    8.1 KB · Views: 7
Last edited:

Some videos you may like

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
11,900
Office Version
  1. 365
Platform
  1. Windows
Looks like you're entering UK format dates with US regional settings. Those that appear normal have probably been messed up where you've changed formats, 7 Sept becoming July 9, etc.

Best way to deal with this is with the original data, without changing the format, select the column of dates. Go to the Data tab on the ribbon, select Text to Columns, choose 'Delimited' and click Next. Uncheck all boxes and click Next. Choose DMY from the date dropdown box and click Finish.
 

ghrek

Board Regular
Joined
Jul 29, 2005
Messages
231
Can I just check when you say original data you mean before I amended anything at all ?
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
11,900
Office Version
  1. 365
Platform
  1. Windows
That is correct, if you perform those steps on the original data (before anything was amended) then it should convert all dates correctly. If you perform the steps on data that has been partially amended then it will break the dates that have already been corrected (day and month will be swapped for dates where the day is less than 12).
 

ghrek

Board Regular
Joined
Jul 29, 2005
Messages
231

ADVERTISEMENT

many thanks
 

ghrek

Board Regular
Joined
Jul 29, 2005
Messages
231
Sorry.

Ive tried doing what you said and it seems to still do it after the macro's has been run. Ive tried the formatting but it not changing.

This is what I get now and it only on some cells..

Also please find the macro that was written for me..
VBA Code:
Option Explicit
Sub CompareSheets()
Dim wsTAB As Worksheet
Dim wsSTN As Worksheet
Dim ws3 As Worksheet
Dim lngRow As Long
Dim lngLastRow1 As Long
Dim lngLastRow2 As Long
Dim lngNextRow As Long
Dim colTAB As Collection
Dim colSTN As Collection
Dim lngTAB As Long
Dim lngSTN As Long
Dim lngNR3 As Long
Dim rngFound As Range
Dim strParts() As String
Dim rng As Range
Dim lngArea As Long
Dim lngCell As Long
Const COL_CONCAT = "X"

Set wsTAB = ThisWorkbook.Worksheets("TAB")
Set wsSTN = ThisWorkbook.Worksheets("STN")
Set ws3 = ThisWorkbook.Worksheets("Sheet3")
ws3.UsedRange.Cells.ClearContents

With wsTAB
    Application.ScreenUpdating = False
    'Insert a blank row at the top of each for filtering purposes
    .Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    wsSTN.Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    lngNextRow = 1
  
    lngLastRow1 = .Cells(Rows.Count, 1).End(xlUp).Row
    For lngRow = 2 To lngLastRow1
        lngNextRow = lngNextRow + 1
        .Cells(lngNextRow, COL_CONCAT) = Join(.Range("A" & lngRow & ":D" & lngRow))
    Next
  
    ' Do the same for the STN sheet
    lngLastRow2 = wsSTN.Cells(Rows.Count, 1).End(xlUp).Row
    lngNextRow = 1
    For lngRow = 2 To lngLastRow2
        lngNextRow = lngNextRow + 1
        wsSTN.Cells(lngNextRow, COL_CONCAT) = Join(wsSTN.Range("A" & lngRow & ":D" & lngRow))
    Next
  
    ' Create a collection of unique concatenated values
    Set colTAB = New Collection
    For lngRow = 2 To lngLastRow1
        On Error Resume Next
        colTAB.Add .Cells(lngRow, COL_CONCAT), CStr(.Cells(lngRow, COL_CONCAT))
        On Error GoTo 0
    Next
  
    ' And the same for STN
    Set colSTN = New Collection
    For lngRow = 2 To lngLastRow2
        On Error Resume Next
        colSTN.Add wsSTN.Cells(lngRow, COL_CONCAT), CStr(wsSTN.Cells(lngRow, COL_CONCAT))
        On Error GoTo 0
    Next

    ' Find duplicates by filtering both tabs and comparing the two counts
    ' of visible rows
    For lngTAB = 1 To colTAB.Count
        ' Clear any previous autofiltering
        On Error Resume Next
        .ShowAllData
        On Error GoTo 0
        .Range(.Cells(1, COL_CONCAT), .Cells(lngLastRow1, COL_CONCAT)).AutoFilter Field:=1, Criteria1:=colTAB(lngTAB)
      
        On Error Resume Next
        wsSTN.ShowAllData
        On Error GoTo 0

        wsSTN.Range(wsSTN.Cells(1, COL_CONCAT), wsSTN.Cells(lngLastRow2, COL_CONCAT)).AutoFilter Field:=1, Criteria1:=colTAB(lngTAB)

        Select Case True
            Case .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count < _
                  wsSTN.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count
                  ' STN count is greater so it's a duplicate
                lngNR3 = lngNR3 + 1
                strParts = Split(colTAB(lngTAB), "|")
                With ws3
                    .Cells(lngNR3, "A") = strParts(0)
                    .Cells(lngNR3, "B") = strParts(1)
                    .Cells(lngNR3, "C") = strParts(2)
                    .Cells(lngNR3, "D") = strParts(3)
                    .Cells(lngNR3, "E") = "DUPLICATED"
                End With
        End Select
  
        ' Find Nissing
        ' Find those in TAB that aren't in STN
        Set rng = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible)
'        If Left(colTAB(lngTAB), 4) = "9755" Then
'            Stop
'        End If

        For lngArea = 1 To rng.Areas.Count
            For lngCell = 1 To rng.Areas(lngArea).Cells.Count
                If Not IsEmpty(rng.Areas(lngArea).Cells(lngCell).Value) Then
                    Set rngFound = wsSTN.Columns(COL_CONCAT).Find(What:=rng.Areas(lngArea).SpecialCells(xlCellTypeVisible).Cells(lngCell).Value, LookIn:=xlFormulas, _
                                   LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                   MatchCase:=False, SearchFormat:=False)
                    If wsSTN.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then
                        ' A count of 1 indicates that only the first row (which is blank) is visible
                        strParts = Split(rng.Areas(lngArea).Cells(lngCell).Value, "|")
                        lngNR3 = lngNR3 + 1
                        With ws3
                            .Cells(lngNR3, "A") = strParts(0)
                            .Cells(lngNR3, "B") = strParts(1)
                            .Cells(lngNR3, "C") = strParts(2)
                            .Cells(lngNR3, "D") = strParts(3)
                            .Cells(lngNR3, "E") = "MISSING FROM STN"
                        End With
                    End If
                End If
            Next
        Next
    Next
    ' Finally, find those in STN that aren't in TAB
    For lngSTN = 1 To colSTN.Count
        ' Clear any previous autofiltering
        On Error Resume Next
        wsSTN.ShowAllData
        On Error GoTo 0
        wsSTN.Range(wsSTN.Cells(1, COL_CONCAT), wsSTN.Cells(lngLastRow1, COL_CONCAT)).AutoFilter Field:=1, Criteria1:=colSTN(lngSTN)
      
        On Error Resume Next
        .ShowAllData
        On Error GoTo 0

        .Range(.Cells(1, COL_CONCAT), .Cells(lngLastRow2, COL_CONCAT)).AutoFilter Field:=1, Criteria1:=colSTN(lngSTN)
        Set rng = wsSTN.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible)
        For lngArea = 1 To rng.Areas.Count
            For lngCell = 1 To rng.Areas(lngArea).Cells.Count
                If Not IsEmpty(rng.Areas(lngArea).Cells(lngCell).Value) Then
                    Set rngFound = .Columns(COL_CONCAT).Find(What:=rng.Areas(lngArea).SpecialCells(xlCellTypeVisible).Cells(lngCell).Value, LookIn:=xlFormulas, _
                                   LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                   MatchCase:=False, SearchFormat:=False)
                    If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then
                        ' A count of 1 indicates that only the first row (which is blank) is visible
                        strParts = Split(rng.Areas(lngArea).Cells(lngCell).Value, "|")
                        lngNR3 = lngNR3 + 1
                        With ws3
                            .Cells(lngNR3, "A") = strParts(0)
                            .Cells(lngNR3, "B") = strParts(1)
                            .Cells(lngNR3, "C") = strParts(2)
                            .Cells(lngNR3, "D") = strParts(3)
                            .Cells(lngNR3, "E") = "MISSING FROM TAB"
                        End With
                    End If
                End If
            Next
        Next
    Next
     
    .Columns(COL_CONCAT).AutoFilter
    wsSTN.Columns(COL_CONCAT).AutoFilter
  
    ws3.Activate
              
    ' Clean up
    .Cells(1, "A").EntireRow.Delete
    wsSTN.Cells(1, "A").EntireRow.Delete
    .Columns(COL_CONCAT).Cells.ClearContents
    wsSTN.Columns(COL_CONCAT).Cells.ClearContents
    Set colSTN = Nothing
    Set colTAB = Nothing
    Set wsTAB = Nothing
    Set wsSTN = Nothing
    Set ws3 = Nothing
  
    Application.ScreenUpdating = True

End With
End Sub
Public Function Join(rng As Range) As String
    Dim cel As Range
  
    For Each cel In rng
        Join = Join & cel.Text & "|"
    Next cel
    ' remove the last delimiter
    Join = Left(Join, Len(Join) - Len("|"))
  
    If Len(Join) < 8 Then
        MsgBox "Invalid data found at row " & rng.Row & " in worksheet " & rng.Worksheet.Name
        Exit Function
    End If
End Function
 

Attachments

  • Untitled.png
    Untitled.png
    5.8 KB · Views: 3

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
11,900
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

What format are the dates in before you run the code above?
Are they aligned to the left or right by default?

I think that I've found the cause, but it would be helpful if you could post some accurate sample data (before the macro is run) for "TAB" and "STN" using XL2BB so that I can do some test runs.
Also, a pre-macro sample of "Sheet3" if it doesn't start empty.
 

ghrek

Board Regular
Joined
Jul 29, 2005
Messages
231
What format are the dates in before you run the code above? UK

Are they aligned to the left or right by default? RIGHT

Sheet 3 always starts empty..

This is TAB

wednesday compare.xlsm
ABCDE
682408629302/07/2020£32.50
692408629303/07/2020£29.20
702408629304/07/2020£20.25
712408629305/07/2020£77.30
722408629306/07/2020£54.60
732408629307/07/2020£34.00
742408629308/07/2020£59.90
752408629309/07/2020£26.50
762408629310/07/2020£17.00
772408629311/07/2020£81.00
782408629312/07/2020£62.70
792408629313/07/2020£5.00
802408629314/07/2020£29.00
812408629315/07/2020£85.15
822408629316/07/2020£34.00
832408629317/07/2020£30.00
842408629318/07/2020£37.00
852408629319/07/2020£54.80
TAB



This is STN

wednesday compare.xlsm
ABCD
32416636015/07/2020£20.00
42416636016/07/2020£73.90
52416636017/07/2020£91.90
62416636018/07/2020£50.60
72416636019/07/2020£45.85
82416636019/07/2020£15.60
92416636020/07/2020£12.00
102416636021/07/2020£22.00
112416636021/07/2020£35.90
122416636022/07/2020£14.80
132416636023/07/2020£33.40
142416636024/07/2020£31.50
152416636024/07/2020£0.00
162416636025/07/2020£68.60
172416636025/07/2020£60.80
184019628716/07/2020£36.70
194019628716/07/2020£40.20
STN


The data thats in TAB is one of them in sheet 3 thats going wrong.

Hope that helps.
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
11,900
Office Version
  1. 365
Platform
  1. Windows
I've made a couple of small edits to the code which appears to fix the date issue, however I did notice that it doesn't appear to flag anything as duplicate (I did add duplicate records to both sheets).
If you need any additional fixes then I will need to know exactly what the code is meant to be checking with regard to duplicates.

Rather than trying to explain what to edit, I've posted the full code below with the changes already made.
VBA Code:
Option Explicit
Sub CompareSheets()
Dim wsTAB As Worksheet
Dim wsSTN As Worksheet
Dim ws3 As Worksheet
Dim lngRow As Long
Dim lngLastRow1 As Long
Dim lngLastRow2 As Long
Dim lngNextRow As Long
Dim colTAB As Collection
Dim colSTN As Collection
Dim lngTAB As Long
Dim lngSTN As Long
Dim lngNR3 As Long
Dim rngFound As Range
Dim strParts() As String
Dim rng As Range
Dim lngArea As Long
Dim lngCell As Long
Const COL_CONCAT = "X"

Set wsTAB = ThisWorkbook.Worksheets("TAB")
Set wsSTN = ThisWorkbook.Worksheets("STN")
Set ws3 = ThisWorkbook.Worksheets("Sheet3")
ws3.UsedRange.Cells.ClearContents

With wsTAB
    Application.ScreenUpdating = False
    'Insert a blank row at the top of each for filtering purposes
    .Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    wsSTN.Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    lngNextRow = 1
  
    lngLastRow1 = .Cells(Rows.Count, 1).End(xlUp).Row
    For lngRow = 2 To lngLastRow1
        lngNextRow = lngNextRow + 1
        .Cells(lngNextRow, COL_CONCAT) = Join(.Range("A" & lngRow & ":D" & lngRow))
    Next
  
    ' Do the same for the STN sheet
    lngLastRow2 = wsSTN.Cells(Rows.Count, 1).End(xlUp).Row
    lngNextRow = 1
    For lngRow = 2 To lngLastRow2
        lngNextRow = lngNextRow + 1
        wsSTN.Cells(lngNextRow, COL_CONCAT) = Join(wsSTN.Range("A" & lngRow & ":D" & lngRow))
    Next
  
    ' Create a collection of unique concatenated values
    Set colTAB = New Collection
    For lngRow = 2 To lngLastRow1
        On Error Resume Next
        colTAB.Add .Cells(lngRow, COL_CONCAT), CStr(.Cells(lngRow, COL_CONCAT))
        On Error GoTo 0
    Next
  
    ' And the same for STN
    Set colSTN = New Collection
    For lngRow = 2 To lngLastRow2
        On Error Resume Next
        colSTN.Add wsSTN.Cells(lngRow, COL_CONCAT), CStr(wsSTN.Cells(lngRow, COL_CONCAT))
        On Error GoTo 0
    Next

    ' Find duplicates by filtering both tabs and comparing the two counts
    ' of visible rows
    For lngTAB = 1 To colTAB.Count
        ' Clear any previous autofiltering
        On Error Resume Next
        .ShowAllData
        On Error GoTo 0
        .Range(.Cells(1, COL_CONCAT), .Cells(lngLastRow1, COL_CONCAT)).AutoFilter Field:=1, Criteria1:=colTAB(lngTAB)
      
        On Error Resume Next
        wsSTN.ShowAllData
        On Error GoTo 0

        wsSTN.Range(wsSTN.Cells(1, COL_CONCAT), wsSTN.Cells(lngLastRow2, COL_CONCAT)).AutoFilter Field:=1, Criteria1:=colTAB(lngTAB)

        Select Case True
            Case .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count < _
                  wsSTN.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count
                  ' STN count is greater so it's a duplicate
                lngNR3 = lngNR3 + 1
                strParts = Split(colTAB(lngTAB), "|")
                With ws3
                    .Cells(lngNR3, "A") = strParts(0)
                    .Cells(lngNR3, "B") = strParts(1)
                    .Cells(lngNR3, "C") = CDate(strParts(2))
                    .Cells(lngNR3, "D") = strParts(3)
                    .Cells(lngNR3, "E") = "DUPLICATED"
                End With
        End Select
  
        ' Find Nissing
        ' Find those in TAB that aren't in STN
        Set rng = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible)
'        If Left(colTAB(lngTAB), 4) = "9755" Then
'            Stop
'        End If

        For lngArea = 1 To rng.Areas.Count
            For lngCell = 1 To rng.Areas(lngArea).Cells.Count
                If Not IsEmpty(rng.Areas(lngArea).Cells(lngCell).Value) Then
                    Set rngFound = wsSTN.Columns(COL_CONCAT).Find(What:=rng.Areas(lngArea).SpecialCells(xlCellTypeVisible).Cells(lngCell).Value, LookIn:=xlFormulas, _
                                   LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                   MatchCase:=False, SearchFormat:=False)
                    If wsSTN.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then
                        ' A count of 1 indicates that only the first row (which is blank) is visible
                        strParts = Split(rng.Areas(lngArea).Cells(lngCell).Value, "|")
                        lngNR3 = lngNR3 + 1
                        With ws3
                            .Cells(lngNR3, "A") = strParts(0)
                            .Cells(lngNR3, "B") = strParts(1)
                            .Cells(lngNR3, "C") = CDate(strParts(2))
                            .Cells(lngNR3, "D") = strParts(3)
                            .Cells(lngNR3, "E") = "MISSING FROM STN"
                        End With
                    End If
                End If
            Next
        Next
    Next
    ' Finally, find those in STN that aren't in TAB
    For lngSTN = 1 To colSTN.Count
        ' Clear any previous autofiltering
        On Error Resume Next
        wsSTN.ShowAllData
        On Error GoTo 0
        wsSTN.Range(wsSTN.Cells(1, COL_CONCAT), wsSTN.Cells(lngLastRow1, COL_CONCAT)).AutoFilter Field:=1, Criteria1:=colSTN(lngSTN)
      
        On Error Resume Next
        .ShowAllData
        On Error GoTo 0

        .Range(.Cells(1, COL_CONCAT), .Cells(lngLastRow2, COL_CONCAT)).AutoFilter Field:=1, Criteria1:=colSTN(lngSTN)
        Set rng = wsSTN.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible)
        For lngArea = 1 To rng.Areas.Count
            For lngCell = 1 To rng.Areas(lngArea).Cells.Count
                If Not IsEmpty(rng.Areas(lngArea).Cells(lngCell).Value) Then
                    Set rngFound = .Columns(COL_CONCAT).Find(What:=rng.Areas(lngArea).SpecialCells(xlCellTypeVisible).Cells(lngCell).Value, LookIn:=xlFormulas, _
                                   LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                   MatchCase:=False, SearchFormat:=False)
                    If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then
                        ' A count of 1 indicates that only the first row (which is blank) is visible
                        strParts = Split(rng.Areas(lngArea).Cells(lngCell).Value, "|")
                        lngNR3 = lngNR3 + 1
                        With ws3
                            .Cells(lngNR3, "A") = strParts(0)
                            .Cells(lngNR3, "B") = strParts(1)
                            .Cells(lngNR3, "C") = CDate(strParts(2))
                            .Cells(lngNR3, "D") = strParts(3)
                            .Cells(lngNR3, "E") = "MISSING FROM TAB"
                        End With
                    End If
                End If
            Next
        Next
    Next
     
    .Columns(COL_CONCAT).AutoFilter
    wsSTN.Columns(COL_CONCAT).AutoFilter
  
    ws3.Activate
              
    ' Clean up
    .Cells(1, "A").EntireRow.Delete
    wsSTN.Cells(1, "A").EntireRow.Delete
    .Columns(COL_CONCAT).Cells.ClearContents
    wsSTN.Columns(COL_CONCAT).Cells.ClearContents
    Set colSTN = Nothing
    Set colTAB = Nothing
    Set wsTAB = Nothing
    Set wsSTN = Nothing
    Set ws3 = Nothing
  
    Application.ScreenUpdating = True

End With
End Sub
Public Function Join(rng As Range) As String
    Dim cel As Range
  
    For Each cel In rng
        Join = Join & cel.Text & "|"
    Next cel
    ' remove the last delimiter
    Join = Left(Join, Len(Join) - Len("|"))
  
    If Len(Join) < 8 Then
        MsgBox "Invalid data found at row " & rng.Row & " in worksheet " & rng.Worksheet.Name
        Exit Function
    End If
End Function
 
Solution

Watch MrExcel Video

Forum statistics

Threads
1,122,364
Messages
5,595,714
Members
414,013
Latest member
tnobbs

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top