Excel do not see date format in columns after consolidation

S

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!
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
Sort by date Sort by votes
Hi & welcome to MrExcel

Could you please post the code that you are currently using?
 
Last edited:
Upvote 0
Fluff said:
Hi & welcome to MrExcel

Could you please post the code that you are currently using?
Click to expand...

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:
Upvote 0
Looking at your code, there's nothing obvious causing your problems.
Are the dates actual values, or are they the result of formulae?
 
Upvote 0
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?
 
Upvote 0
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
 
Upvote 0
Fluff said:
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
Click to expand...

Thank you very much for this, where precisely shall I put this code?
 
Upvote 0
Replace your existing block if in the Consolidation macro, with that.
 
Upvote 0
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:
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Excel Date Formatting Issue
Replies
6
Views
486
Joe4
Joe4
S
  • Solved
Conditional Formatting for when the month/year date for the same ID on two worksheets doesn't match
Replies
7
Views
159
etaf
etaf
G
  • Question Question
VB Issue pulling data with date specific
Replies
4
Views
385
Trevor G
Trevor G
G
  • Solved
History of Dates to be traced in Excel (2010) in DD/MM/YYYY format
2
Replies
11
Views
1K
MARK858
MARK858
T
  • Solved
Problem with date format when reading from workbook via SQL / ADODB
Replies
7
Views
847
Thebatfink
T

Forum statistics

Threads
1,224,820
Messages
6,181,160
Members
453,021
Latest member
Justyna P

Share this page

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
Back
Top