Excel do not see date format in columns after consolidation

szsmie

New Member
Joined
Feb 7, 2018
Messages
6
Hey Guys,

I have really strange issue connected to the master tracker, which consolidates data from several other 'individual' trackers.

Once I consolidate data, everything from 'individual' trackers flows to master tracker (they look perfectly the same in terms of view, columns, etc.).

The only problem is, that all dates flowing to master tracker loose their format (even if in each 'individual' tracker dates, as formatted and identified by excel as dates). By this I mean a situation, when excel see each date as text or it sees dates, however changes formatting from European format dd-mm-yyy to US mm-dd-yyyy, meaning that 10-01-2018 (tenth of Jan. 2018) excel reads as (first Oct. 2018).

Is there any easy way to, I don't know, add condition to macro to keep source ('individual' tracker formatting of dates) or any formula to ?

Since, this is my first post here, please let me know if you need any additional information, to identify the issue.

Thanks in advance!
 

Some videos you may like

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
38,439
Office Version
365
Platform
Windows
Hi & welcome to MrExcel

Could you please post the code that you are currently using?
 
Last edited:

szsmie

New Member
Joined
Feb 7, 2018
Messages
6
Hi & welcome to MrExcel

Could you please post the code that you are currently using?
Code:
Sub Consolidation()
'GoTo wheretostart
Dim filescount As Integer, i As Integer, Drw As Integer, cl As Integer, WS As Worksheet
Dim LastRow As Long, Srw As Integer, nameCount As Integer, array_sheets(4), StopCol As Integer
    
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


array_sheets(1) = "Data"
array_sheets(2) = "Posting"
array_sheets(3) = "BR"
array_sheets(4) = "Offers"


'clear current data to write over
Application.DisplayAlerts = False
For k = 1 To 4
    Worksheets(array_sheets(k)).Copy After:=Sheets("Values")
    Worksheets(array_sheets(k) & " BU").Delete
    ActiveSheet.Name = array_sheets(k) & " BU"
    ActiveSheet.Visible = False
    Worksheets(array_sheets(k)).Activate
    Range("A2:AI1000000").ClearContents
Next k
Application.DisplayAlerts = True


'get number of files
filescount = Sheets("Consolidation").Range("A30").End(xlUp).Row


If filescount = 1 Then
    MsgBox "There are no Files. Please add some first."
    GoTo Exit_this_Sub
Else


    Dim Source As Worksheet
    Dim Destination As Worksheet
    'set destination row
    Drw = 2
    For i = 7 To filescount
    'reset source row
    On Error GoTo Error1:
    
    Application.StatusBar = "Please wait. Downloading the information from " & ThisWorkbook.Sheets("Consolidation").Cells(i, 2) & " (Tracker " & i - 6 & "/" & filescount - 6 & ")"
    Workbooks.Open ThisWorkbook.Sheets("Consolidation").Cells(i, 1), False, True  ', , "Masterkpi2015"
    
        For k = 1 To 4
        Srw = 2
            Set Source = ActiveWorkbook.Sheets(array_sheets(k))
            Set Destination = ThisWorkbook.Sheets(array_sheets(k))
            Drw = Destination.Range("A1000000").End(xlUp).Row + 1
            StopSrw = Source.Range("B20000").End(xlUp).Row
            StopCol = Source.Range("A1").End(xlToRight).Column
            For Srw = Srw To StopSrw
                For cl = 1 To StopCol
                    If IsError(Source.Cells(Srw, cl)) Then
                        Destination.Cells(Drw, cl + 1) = Source.Cells(Srw, cl)
                    Else
                        Destination.Cells(Drw, cl + 1) = Trim(Source.Cells(Srw, cl))
                    End If
                Next cl
                Destination.Cells(Drw, 1) = ThisWorkbook.Sheets("Consolidation").Cells(i, 2).Value
                Drw = Drw + 1
            Next Srw
        Next k
stopCopy:
        Source.Parent.Close False
    Next i


For k = 1 To 4
    Worksheets(array_sheets(k)).Activate
    Range(Rows("2:2"), Rows("2:2").End(xlDown)).Select
    With Selection
        .WrapText = False
    End With
    Range("A2").Select
Next k
ThisWorkbook.Sheets("Data").Activate


End If


MsgBox ("Downloaded successfully!")
'wheretostart:
Exit_this_Sub:
Application.StatusBar = ""
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Exit Sub


Error1:
MsgBox "The tracker of " & ThisWorkbook.Sheets("Consolidation").Cells(i, 2) & " cannot be opened. Please check if the file exists under the specified path with the right name and is not corrupted."




End Sub

Code:
Sub updateConfig()
'GoTo wheretostart
Dim filescount As Integer, i As Integer, Drw As Integer, cl As Integer, WS As Worksheet
Dim LastRow As Long, Srw As Integer, nameCount As Integer, array_sheets(3), StopCol As Integer
    
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


'get number of files
filescount = Sheets("Consolidation").Range("A30").End(xlUp).Row


If filescount = 1 Then
    MsgBox "There are no Files. Please add some first."
    GoTo Exit_this_Sub
Else


    Dim Source As Worksheet
    Dim Destination As Worksheet
    For i = 7 To filescount
    'reset source row
    On Error GoTo Error1:
    
        Application.StatusBar = "Please wait. Setting config for" & ThisWorkbook.Sheets("Consolidation").Cells(i, 2) & " (Tracker " & i - 6 & "/" & filescount - 6 & ")"
        Workbooks.Open ThisWorkbook.Sheets("Consolidation").Cells(i, 1), False, False  ', , "Masterkpi2015"
                
            Set Destination = ActiveWorkbook.Sheets("Values")
            Set Source = ThisWorkbook.Sheets("Values")
        
        Source.Range("A1:O50").Copy
        Destination.Range("A1:O50").PasteSpecial (xlPasteAll)
            
stopCopy:
        Destination.Parent.Close SaveChanges:=True
    Next i
    
ThisWorkbook.Sheets("Data").Activate
Range("A1").Select
End If


MsgBox ("Updated successfully!")
'wheretostart:
Exit_this_Sub:
Application.StatusBar = ""
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Exit Sub


Error1:
MsgBox "The tracker of " & ThisWorkbook.Sheets("Consolidation").Cells(i, 2) & " cannot be opened. Please check if the file exists under the specified path with the right name and is not corrupted."




End Sub
 
Last edited by a moderator:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
38,439
Office Version
365
Platform
Windows
Looking at your code, there's nothing obvious causing your problems.
Are the dates actual values, or are they the result of formulae?
 

szsmie

New Member
Joined
Feb 7, 2018
Messages
6
those are actual dates.

is there any chance, to add condition to identify dates and put them in, let's say dd/mm/yyyy format?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
38,439
Office Version
365
Platform
Windows
Untested, but try
Code:
If IsError(Source.Cells(Srw, Cl)) Then
   Destination.Cells(Drw, Cl + 1) = Source.Cells(Srw, Cl)
ElseIf IsDate(Source.Cells(Srw, Cl)) Then
   Destination.Cells(Drw, Cl + 1) = Format(Source.Cells(Srw, Cl), "dd,mm,yyyy")
Else
   Destination.Cells(Drw, Cl + 1) = trim(Source.Cells(Srw, Cl))
End If
 

szsmie

New Member
Joined
Feb 7, 2018
Messages
6
Untested, but try
Code:
If IsError(Source.Cells(Srw, Cl)) Then
   Destination.Cells(Drw, Cl + 1) = Source.Cells(Srw, Cl)
ElseIf IsDate(Source.Cells(Srw, Cl)) Then
   Destination.Cells(Drw, Cl + 1) = Format(Source.Cells(Srw, Cl), "dd,mm,yyyy")
Else
   Destination.Cells(Drw, Cl + 1) = trim(Source.Cells(Srw, Cl))
End If
Thank you very much for this, where precisely shall I put this code?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
38,439
Office Version
365
Platform
Windows
Replace your existing block if in the Consolidation macro, with that.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
38,439
Office Version
365
Platform
Windows
Did you put it in like this
Code:
Sub Consolidation()
'GoTo wheretostart
Dim filescount As Integer, i As Integer, Drw As Integer, cl As Integer, WS As Worksheet
Dim LastRow As Long, Srw As Integer, nameCount As Integer, array_sheets(4), StopCol As Integer
    
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


array_sheets(1) = "Data"
array_sheets(2) = "Posting"
array_sheets(3) = "BR"
array_sheets(4) = "Offers"


'clear current data to write over
Application.DisplayAlerts = False
For k = 1 To 4
    Worksheets(array_sheets(k)).Copy After:=Sheets("Values")
    Worksheets(array_sheets(k) & " BU").Delete
    ActiveSheet.Name = array_sheets(k) & " BU"
    ActiveSheet.Visible = False
    Worksheets(array_sheets(k)).Activate
    Range("A2:AI1000000").ClearContents
Next k
Application.DisplayAlerts = True


'get number of files
filescount = Sheets("Consolidation").Range("A30").End(xlUp).Row


If filescount = 1 Then
    MsgBox "There are no Files. Please add some first."
    GoTo Exit_this_Sub
Else


    Dim Source As Worksheet
    Dim Destination As Worksheet
    'set destination row
    Drw = 2
    For i = 7 To filescount
    'reset source row
    On Error GoTo Error1:
    
    Application.StatusBar = "Please wait. Downloading the information from " & ThisWorkbook.Sheets("Consolidation").Cells(i, 2) & " (Tracker " & i - 6 & "/" & filescount - 6 & ")"
    Workbooks.Open ThisWorkbook.Sheets("Consolidation").Cells(i, 1), False, True  ', , "Masterkpi2015"
    
        For k = 1 To 4
        Srw = 2
            Set Source = ActiveWorkbook.Sheets(array_sheets(k))
            Set Destination = ThisWorkbook.Sheets(array_sheets(k))
            Drw = Destination.Range("A1000000").End(xlUp).Row + 1
            StopSrw = Source.Range("B20000").End(xlUp).Row
            StopCol = Source.Range("A1").End(xlToRight).Column
            For Srw = Srw To StopSrw
                For cl = 1 To StopCol
                  [COLOR=#0000ff] If IsError(Source.Cells(Srw, cl)) Then
                        Destination.Cells(Drw, cl + 1) = Source.Cells(Srw, cl)
                     ElseIf IsDate(Source.Cells(Srw, cl)) Then
                        Destination.Cells(Drw, cl + 1) = Format(Source.Cells(Srw, cl), "dd,mm,yyyy")
                     Else
                        Destination.Cells(Drw, cl + 1) = trim(Source.Cells(Srw, cl))
                     End If[/COLOR]
                Next cl
                Destination.Cells(Drw, 1) = ThisWorkbook.Sheets("Consolidation").Cells(i, 2).Value
                Drw = Drw + 1
            Next Srw
        Next k
stopCopy:
        Source.Parent.Close False
    Next i


For k = 1 To 4
    Worksheets(array_sheets(k)).Activate
    Range(Rows("2:2"), Rows("2:2").End(xlDown)).Select
    With Selection
        .WrapText = False
    End With
    Range("A2").Select
Next k
ThisWorkbook.Sheets("Data").Activate


End If


MsgBox ("Downloaded successfully!")
'wheretostart:
Exit_this_Sub:
Application.StatusBar = ""
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Exit Sub


Error1:
MsgBox "The tracker of " & ThisWorkbook.Sheets("Consolidation").Cells(i, 2) & " cannot be opened. Please check if the file exists under the specified path with the right name and is not corrupted."




End Sub
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,095,177
Messages
5,442,840
Members
405,201
Latest member
kashyap44

This Week's Hot Topics

  • Copy entire row if CountA <>0 to another sheet
    [B]I want to copy entire row if CountA <>0 for column J7:AM7 (headers on J6:AM6) and so on till the last used cell is column D and paste the...
  • Select last used Row in Table
    I have created a Table in a Worksheet which is locked to prevent user errors and protect formula. Some of the cells require freetext entries which...
  • excel workbook: do not allow certain file name
    Hello all, Don't think this has ever been asked before, but how do I restrict file save [Before_Save Event] if the name of the file being saved...
  • fixing problem autofilter
    hello i need help about my code when i search by code in textbox it doesn't show anything this is my data [ATTACH type="full"...
  • “Weight”
    Hi, i’ve got a long sheet filled with weights such as kg,g,L & ml. i can build a formula to convert kg into g and liter into ml. How ever, my...
  • How to capitalize everything before a certain character?
    In column A, I have some text: Hello good day.mp3 Hello good day.flac etc. I'd like to capitalize everything before the period. I don't need the...
Top