I have a project where I need to open all territory files associated with a district in a range of districts, looping through each district. All files for that district need to be opened in the periods (months) equal to and prior to an inputted month value. The files need to be opened one at a time with values from certain variant worksheets in that file copied and pasted into another master file. The structure of the files is Path\Year\District\Period\Territory.xlsx.
I am encountering errors with the following code which attempts to capture the month for the report and compare it to the Period variable. I am getting the Next without For error.
Sub DSMReports()
Sheets("START").Activate
Dim MM As Variant
Dim YYYY As Variant
MM = InputBox("Enter Month for reporting in MM format: 01-12")
YYYY = InputBox("Enter Year for reporting in YYYY format")
Range("C6").Value = MM
Range("C8").Value = YYYY
Dim DistrictDSM As Range
Dim DistrictsDSMList As Range
Set DistrictsDSMList = Start.Range("E11:E23")
Dim Path As String
Dim DistPeriodFile As String
Dim Total As Integer
Dim Period As Integer
For Each DistrictDSM In DistrictsDSMList.Cells
Total = 0
For Period = 1 To MM
Period = Total + 1
If Period < 10 Then Path = "\\corsrv027\Accounting\Monthend " & YYYY & "\DSM Files\" & DistrictDSM & "\P0" & Period
If Period >= 10 Then Path = "\\corsrv027\Accounting\Monthend " & YYYY & "\DSM Files\" & DistrictDSM & "\P" & Period
DistPeriodFile = Dir(Path & "\*.xlsx")
Do While DistPeriodFile <> ""
Workbooks.Open Filename:=Path & "\" & DistPeriodFile
'Do copying, pasting, and going through each worksheet one at a time here
DistPeriodFile = Dir
Next Period
Next DistrictDSM
Loop
End Sub
Fix the Next Without For error by moving the Loop of the Do While loop before the Next Period and Next DistrictDSM. Indentation visualizes and helps properly structure your loops, and would have highlighted your "interwoven" loop structure.
For Each DistrictDSM In DistrictsDSMList.Cells
' code
For Period = 1 To MM
' more code
Do While DistPeriodFile <> ""
' more code
Loop
Next Period
Next DistrictDSM
Related
I have some macros that were working previously like:
Sub test()
'
' test Macro
'
Windows("_Macro_Duplicate Billing Templates.xltm").Activate
Src2 = Sheets("Parameters").Range("C12").Value
Workbooks.Open Filename:=Src2
End Sub
where I indicated "D:\Users\D801878\Int'l\Billing\2017_03\Billing Template_International_2017_03.xlsx" in cell C12
This was working in 2016 till now. Now I get the error that "D:\Users\D801878\Int'l\Billing\2017_03\Billing Template_International_2017_03.xlsx is not found."
Did anything change in terms of naming the filepath and filename?
I recommend to make like this:
I'm supposed the value 03 means the number of the month witch is march or mar, so:
Put in C12 the date mar.2017 and use the following code:
Dim y As Integer
Dim m As String
Dim ws As Worksheet
Dim link As String
Set ws = ThisWorkbook.Worksheets("Parameters")
y = Format(ws.Range("C12"), "yyyy")
m = Format(ws.Range("C12"), "mm")
link = "D:\Users\D801878\Int'l\Billing\" & y & "_" & m & "\Billing_Template_International_" & y & "_" & m & ".xlsx"
Workbooks.Open link
I am trying build a macro to give me the date and time production will end based on a value entered into cell A2. At present each unit takes 1 min 5 sec to produce. the shift will finish at 00:30 and restart at 05:30 so I would like it to take this into consideration.
Some examples
If the date/time is 14/03/2017 22:00 and I enter 55 into cell A2 I would expect a return of 14/03/2017 23:00 in cell E2.
If the date/time is 14/03/2017 22:00 and I entered 1 into cell A2 I would expect a return of 14/03/2017 22:01 in cell E2.
If the time is 14/03/2017 23:55 and I entered 55 into cell A2 I would expect a return of 15/03/2017 05:55
So at the moment I am using this code which works well within the shift but I cant get any further with it ie. going into the next days production.
Range("A2").Value * Range("C2").Value + Now()
A2 being the number of units and C2 being the process time 0,1,5
Many thanks for your help /advice
I'm not sure what the problem is. The maths are (units * time-per-unit) + start time. The brackets are for visual clrity only; mathematical precedence will ensure that the multiplication takes place before the addition.
With Worksheets("sheet1")
.Range("E2") = Now
.Range("F2") = .Range("E2").Value2 + (.Range("A2").Value2 * .Range("C2").Value2)
.Range("G2") = Application.Ceiling(.Range("F2").Value2, TimeSerial(0, 0, 1))
.Range("E2:G2").NumberFormat = "[Color10][$-en-US]dd-mmm-yyyy hh:mm;[Color3]#"
End With
FWIW, I've had better success using .Value2 instead of .Value as it is a raw numerical without additional date/time/currency information.
This took a little time but it turned out rather nice. Follow these instructions to test.
Create a standard code module in the workbook in which you want the action to occur. The name will be "Module1" by default. I suggest you change it to "Main" or some better, descriptive name. Paste the following enumerations at the top of your module, including the option statement.
Option Explicit
Enum Nws ' Worksheet navigation
NwsFirstDataRow = 2
NwsQty = 1 ' Columns (not necessarily contiguous):
NwsTime ' time to produce one unit
NwsStart ' date/time
NwsEnd ' date/time
End Enum
This enumeration serves to identify rows and columns in your worksheet. Note that columns are numbered (1=A, 2=B, 3=C etc.) Enumerations without a value assume the value of the previous one +1. So, NwsEnd = 4 = column D. You can set up the sheet according to the enum or adjust the enum values to match your sheet, but you must have a column for each of Quantity, Production time, Production Start time, and Production completion time. NwsFirstDataRow serves to prevent the macro from changing data you don't want changed - at least those in the caption row, here presumed to be row 1.
Now past the next enumeration below the above.
Enum Nsh ' Shift (use 24h format)
NshStart = 530 ' read as 05:30 (on current day)
NshEnd = 2430 ' read as 00:30 (on next day)
End Enum
This enum holds a code for your shift time. In the future, if your working hours change, you can modify the code's output simply by changing these numbers.
The next sub is doing most of the work.
Sub SetCompletion(Ws As Worksheet, R As Long)
' 20 Mar 2017
Dim Qty As Long
Dim ShiftQty As Long, DayQty As Long
Dim UnitTime As Double, StartTime As Double
Dim ComplDate As Double
Dim Days As Integer
With Rows(R)
Qty = .Cells(NwsQty).Value
UnitTime = .Cells(NwsTime).Value
StartTime = .Cells(NwsStart).Value
If Qty And (UnitTime > 0) And (StartTime > 0) Then
ComplDate = (UnitTime * Qty) + StartTime
ShiftQty = QtyTillShiftEnd(StartTime, UnitTime)
If ShiftQty < Qty Then
Qty = Qty - ShiftQty
DayQty = DailyProduction(UnitTime)
ComplDate = StartTime + 1 + Int(Qty / DayQty)
ComplDate = ComplDate + UnitTime * (Qty Mod DayQty)
End If
.Cells(NwsEnd).Value = ComplDate
End If
End With
End Sub
Its basic calculation method is to first calculate how many units can be produced from the start of production until the end of that day's shift. Then calculate the full days' production, and calculate the completion from the number of remaining units to be produced on the last day. No such calculation will be made while any of the 3 required components are missing (Qty, Time, StartTime). The following functions are helping in the calculation. Paste them at the bottom of the same "Main" code module.
Private Function QtyTillShiftEnd(ByVal StartTime As Double, _
ByVal UnitTime As Double) As Double
' 20 Mar 2017
Dim ProdTime As Double
ProdTime = (Int(StartTime) + NshToDays(NshEnd) - StartTime)
QtyTillShiftEnd = (ProdTime + 0.0001) / UnitTime
End Function
Calculates the quantity that can be produced from the start time until the end of the first production day's shift. The next function calculates a full day's production.
Private Function DailyProduction(UnitTime As Double) As Integer
' 19 Mar 2017
DailyProduction = Int((NshToDays(NshEnd) - NshToDays(NshStart) + 0.000001) / UnitTime)
End Function
When working with Double type numbers, required for time calculations, VB has difficulty calculating zero. The 0.000001 added to the result ensures that the calculation doesn't end up below zero when zero is required. The next function converts the encoded shift times from Enum Nsh into fractions of days which this program can work with.
Private Function NshToDays(TimeCode As Nsh) As Double
' 19 Mar 2017
Dim H As Double, M As Double
H = Int(TimeCode / 100)
M = TimeCode Mod 100
NshToDays = (1 / 24 * H) + (1 / 24 / 60 * M)
End Function
The next function corrects wrong entries in the StartTime column NwsStart.
Function AdjustedStartTime(ByVal StartTime As Double) As Double
' 19 Mar 2017
' return new StartTime or 0
Dim Fun As Double
Dim StartDate As Long
Dim ShiftStart As Double, ShiftEnd As Double
ShiftStart = NshToDays(NshStart)
ShiftEnd = NshToDays(NshEnd)
StartDate = Int(StartTime)
StartTime = StartTime - StartDate
Fun = StartTime
If ShiftEnd > 1 Then
If StartTime < (ShiftStart - Int(ShiftStart)) Then
If StartTime > (ShiftEnd - Int(ShiftEnd)) Then Fun = ShiftStart
End If
Else
If (StartTime - Int(StartTime)) < ShiftStart Then
Fun = ShiftStart
Else
If StartTime > ShiftEnd Then Fun = ShiftStart + 1
End If
End If
AdjustedStartTime = Fun + StartDate
End Function
This function's action is to make sure that no one enters a time like 4:00 am. If someone does the entry will be changed to 05:30 because that's when the shift starts.
The last procedure in this code sheet formats cells.
Sub FormatCells(Row As Range)
' 19 Mar 2017
Dim Fmt As Variant, Clm As Variant
Dim i As Integer
' match for number formats in 'Fmt' to the column numbers in 'Clm'
Clm = Array(NwsQty, NwsTime, NwsStart, NwsEnd)
Fmt = Array("#,##0", "hh:mm:ss", "dd mmm hh:mm", "dd mmm hh:mm")
For i = 0 To UBound(Clm)
Row.Cells(Clm(i)).NumberFormat = Fmt(i)
Next i
End Sub
This sub will be called whenever a production quantity is entered. You can adjust the cell formats here. This goes especially for the date formats which I may not have done to your liking.
Now, still in the VBE window, please find the code sheet for the worksheet on which you have the columns first above enumerated. It might be listed in the Project window as Sheet1(Sheet1) or similar. It is important that you identify the correct sheet and paste the following procedure there.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' 20 Mar 2017
Dim Entry As Variant
With Target
' no action when more than one cell is modified at once
If .Cells.Count = 1 And .Row >= NwsFirstDataRow Then
Application.EnableEvents = False
Entry = .Value
Select Case .Column
Case NwsQty
If Val(Entry) < 1 Then
If Len(Entry) > 0 Then
MsgBox "Please enter a number representing" & vbCr & _
"the quantity to be produced.", vbExclamation, _
"Invalid entry"
.Select
End If
Else
FormatCells Rows(.Row)
SetCompletion ActiveSheet, .Row
End If
Case NwsTime
If Val(Entry) Then
SetCompletion ActiveSheet, .Row
Else
If Len(Entry) > 0 Then
MsgBox "The production time must be entered" & vbCr & _
"in the format h:m:s", vbExclamation, _
"Invalid entry"
.Select
End If
End If
Case NwsStart
If Val(Entry) Then
If (Val(Entry) < 1) Then .Value = Entry + Date
Entry = AdjustedStartTime(.Value)
If .Value <> Entry Then
MsgBox "On " & Format(Entry, "mmm d") & " production doesn't " & _
"start until " & Format(Entry, "h:mm") & "." & vbCr & _
"Your entry was adjusted accordingly.", _
vbInformation, "Corrected time entry"
.Value = Entry
End If
SetCompletion ActiveSheet, .Row
Else
MsgBox "The production start must be entered as a Time" & vbCr & _
"or Dtae/Time value in the format [d/m/yy] HH:mm", _
vbExclamation, "Invalid entry"
.Select
End If
Case NwsEnd
MsgBox "Recalculate with a new production start?" & vbCr & _
"The completion date is the result of a calculation." & vbCr & _
"To change it, modify the unit production time.", _
vbInformation, "Invalid action"
Application.Undo
End Select
Application.EnableEvents = True
End If
End With
End Sub
You can get a fair idea of what this procedure does by reading the various error messages it can spit out. You can modify these texts. Note that you can enter the start time as a time or Date/Time. If you enter time only the macro will add the current date automatically. In the absence of errors this macro will call the sub SetCompletion which will write the completion date to the sheet if all criteria for its calculation are present.
Note that there is no protection of your data after change of Enum Nsh. To avoid overwriting existing completion dates which were calculated with previously correct shift times, set the enumeration NwsFirstDataRow to exclude rows you wish to protect in this way.
All components have been tested, but the project as a whole is rather complex and you would do well to watch the results in real life. You may have noticed that I have structured the code in such a way that faults can easily be attributed to specific functions which may then have to be improved without putting everything into question.
The problem is with the date format, more specifically, the input date format in the start time column. The macro will only calculate if a start time is given. So, when the start time is given but not recognised as such no calculation takes place.
I programmed for day/month/year and you are using the American system. Please replace the existing procedure of the same name with this one.
Sub FormatCells(Row As Range)
' 25 Mar 2017
Dim Fmt As Variant, Clm As Variant
Dim i As Integer
' match for number formats in 'Fmt' to the column numbers in 'Clm'
Clm = Array(NwsQty, NwsTime, NwsStart, NwsEnd)
Fmt = Array("#,##0", "hh:mm:ss", "mmm dd hh:mm", "mmm dd hh:mm")
For i = 0 To UBound(Clm)
Row.Cells(Clm(i)).NumberFormat = Fmt(i)
Next i
End Sub
Modifications have also been made to the event procedure which will now recognise dates entered in your format. Please remember that you are supposed to be able to enter the start time as 7:30 and have the cell display Mar 25 07:30. Try this. also try entering "Mar 20 7:30", "3/20/17 7:30", "3/20 7:30", and then "3/20/17 14:00" and perhaps "3/20/17 2:00 PM". If it doesn't work that would be indication of bigger wrongs behind the scenes.
Private Sub Worksheet_Change(ByVal Target As Range)
' 25 Mar 2017
Dim Entry As Variant
With Target
' no action when more than one cell is modified at once
If .Cells.Count = 1 And .Row >= NwsFirstDataRow Then
Application.EnableEvents = False
Entry = .Value
Select Case .Column
Case NwsQty
If Val(Entry) < 1 Then
If Len(Entry) > 0 Then
MsgBox "Please enter a number representing" & vbCr & _
"the quantity to be produced.", vbExclamation, _
"Invalid entry"
.Select
End If
Else
FormatCells Rows(.Row)
SetCompletion ActiveSheet, .Row
End If
Case NwsTime
If Val(Entry) Then
SetCompletion ActiveSheet, .Row
Else
If Len(Entry) > 0 Then
MsgBox "The production time must be entered" & vbCr & _
"in the format h:m:s", vbExclamation, _
"Invalid entry"
.Select
End If
End If
Case NwsStart
If IsDate(Entry) Then
If (CDbl(Entry) < 1) Then .Value = Entry + Date
Entry = AdjustedStartTime(.Value)
If .Value <> Entry Then
MsgBox "On " & Format(Entry, "mmm d") & " production doesn't " & _
"start until " & Format(Entry, "h:mm") & "." & vbCr & _
"Your entry was adjusted accordingly.", _
vbInformation, "Corrected time entry"
.Value = Entry
End If
SetCompletion ActiveSheet, .Row
Else
MsgBox "The production start must be entered as a Time" & vbCr & _
"or Date/Time value in the format [m/d/yy] HH:mm", _
vbExclamation, "Invalid entry"
.Select
End If
Case NwsEnd
MsgBox "Recalculate with a new production start?" & vbCr & _
"The completion date is the result of a calculation." & vbCr & _
"To change it, modify the unit production time.", _
vbInformation, "Invalid action"
Application.Undo
End Select
Application.EnableEvents = True
End If
End With
End Sub
Last but not least, I discovered an error in the calculation of the completion time affecting production time ending not on the same day. I corrected it. Please exchange the functions.
Sub SetCompletion(ws As Worksheet, R As Long)
' 25 Mar 2017
Dim Qty As Long
Dim ShiftQty As Long, DayQty As Long
Dim UnitTime As Double, StartTime As Double
Dim ComplDate As Double
Dim Days As Integer
With Rows(R)
Qty = .Cells(NwsQty).Value
UnitTime = .Cells(NwsTime).Value
StartTime = .Cells(NwsStart).Value
If Qty And (UnitTime > 0) And (StartTime > 0) Then
ComplDate = (UnitTime * Qty) + StartTime
ShiftQty = QtyTillShiftEnd(StartTime, UnitTime)
If ShiftQty < Qty Then
Qty = Qty - ShiftQty
DayQty = DailyProduction(UnitTime)
ComplDate = Int(StartTime) + 1 + NshToDays(NshStart) + Int(Qty / DayQty)
ComplDate = ComplDate + UnitTime * (Qty Mod DayQty)
End If
.Cells(NwsEnd).Value = ComplDate
End If
End With
End Sub
Actually, this procedure should be further amended to recognise weekends, but I hope that your production wouldn't stop on Sundays :-)
I shall appreciate your bearing with me in case you still face a problem with the dates. I could change the default settings on my PC for better testing, but so far I have avoided doing so. :-)
The text in your event procedure should be changed in the light of changes you want to make to the code. Please replace as follows:-
MsgBox "You entered a time during which production rests." & vbCr & _
"The next shift after that will start on " & _
Format(Entry, "dddd,") & vbCr & _
Format(Entry, "mmmm d,") & " at " & _
Format(Entry, "h:mm") & "." & vbCr & _
"Your entry was adjusted accordingly.", _
vbInformation, "Corrected time entry"
' MsgBox "On " & Format(Entry, "mmm d") & " production doesn't " & _
' "start until " & Format(Entry, "h:mm") & "." & vbCr & _
' "Your entry was adjusted accordingly.", _
' vbInformation, "Corrected time entry"
Meaning, look for the lines of code with apostrophes at their beginning above and replace them with the liens that don't have an apostrophe.
I suggest you post a link to this thread in the new thread you just started.
I have a worksheet that is sorted by name. Some names may have several rows worth of data, some may only be found on one row. I would like to go through this worksheet and pull 3 pieces of data from each row and use that data to construct the body of an email. And I only want to send one email per person.
So if the name on the following row matches the current row I don't want to send the email yet, I want to pull the 3 pieces of data I need from that row, and it to what was grabbed from the row above, and again evaluate if that is the final row for the person.
I am new to coding and have hit some "writer's block" in trying to overcome this issue. Any help would be appreciated.
I think I struggled because I was trying to do it in one Sub and it started to get too cluttered. Instead I broke it down into easier to follow pieces. Here is how I ultimately decided to solve this (I'm leaving out the sorting piece and a function that arranges the recipient's name):
Sub EDBRemitMain()
Dim lRowCount As Long
Dim lCount As Long
'First we will sort the data
Call EDBRemitSort
'Figure out how many rows of data the sheet has:
Range("A1").Select
Selection.End(xlDown).Select
lRowCount = ActiveCell.Row
'We will start on row 2 since the worksheet will always have a header row.
For lCount = 2 To lRowCount
Call EDBRemitEmailBody(lCount, lRowCount)
Next lCount
End Sub
Sub EDBRemitEmailBody(lCount As Long, lRowCount As Long)
Dim BodyEmail1
Dim BodyEmail2
Dim cRunningTotal As Currency
Dim sDate As String
Dim lTripNum As Long
Dim sCustomer As String
Dim cTotal As Currency
Dim sNameEval1 As String
Dim sNameEval2 As String
'Reset cRunningtotal
cRunningTotal = 0
'Run until there are no more rows of data.
Do Until lCount = lRowCount + 1
'Set the total amount, customer, trip number, and date we will use in the email's body, and update the running total.
sDate = Cells(lCount, 4)
sCustomer = Cells(lCount, 8)
cTotal = Cells(lCount, 29)
lTripNum = Cells(lCount, 1).Value
cRunningTotal = cRunningTotal + cTotal
'Start building the body of the email
BodyEmail1 = "Hello" & "<p>" & "You are being reimbursed for the following expenses, for which the total amount is <B>€" & cRunningTotal & "</B></p>"
BodyEmail2 = BodyEmail2 & "<p>" & sDate & " " & sCustomer & " " & "€" & cTotal & " " & "http://url/linking/to/a/detailed/BreakdownOfExpenses.aspx?TripID=" & lTripNum & "</p>"
'Set variables that we will use to see if the name in the next row matches the name on the current row.
Cells(lCount, 3).Activate
sNameEval1 = ActiveCell.Value
sNameEval2 = ActiveCell.Offset(1, 0)
If sNameEval1 <> sNameEval2 Then
Call EDBSendEmail(BodyEmail1, BodyEmail2, lCount)
Exit Sub
Else
End If
lCount = lCount + 1
Loop
End Sub
Sub EDBSendEmail(BodyEmail1, BodyEmail2, lCount)
Dim sName As String
Dim aOutlook As Object
Dim aEmail As Object
Set aOutlook = CreateObject("Outlook.Application")
Set aEmail = aOutlook.CreateItem(0)
'Grab the names we want to flip, feed it into our function and return
sName = FlipNames(Cells(lCount, 3).Value)
With aEmail
.Subject = "Trip Reimbursement"
.HTMLBody = BodyEmail1 & BodyEmail2
.To = sName
.BCC = "Person I am BCCing"
'For the test we will Display the emails rather than automatically sending them.
'.Display
.Send
End With
Set aOutlook = Nothing
End Sub
I am using this code (as part of a bigger macro) to reference a cell in a specific dated file. The reference file is a daily backup version that is saved to a shared drive using mm-dd-yy format.
I want to use VBA code (using mm-dd-yy) to change this formula to reference the file for the next day, that is change "05-07-14" to "05-08-14":
Range("CL2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC1,'G:\TCI_PM\Port Rept & Perf Track\Daily Reprojections\TPV datafiles\[TPV datafile - 05-07-14.xlsx]TPV Data Pull'!C1:C88,36,FALSE)"
Here is some code to Parse a USA date that runs in UK...
Sub TestParseUSDate()
Debug.Assert VBA.FormatDateTime(ParseUSDate("05-07-14"), vbLongDate) = "07 May 2014"
End Sub
Function ParseUSDate(ByVal sUSADate As String) As Date
Debug.Assert Len(sUSADate) >= 8
Dim lMonth As Long
lMonth = Left$(sUSADate, 2)
Debug.Assert Not (IsNumeric(Mid$(sUSADate, 3, 1)))
Dim lDay As Long
lDay = Mid$(sUSADate, 4, 2)
Debug.Assert Not (IsNumeric(Mid$(sUSADate, 6, 1)))
Dim lYear As Long
lYear = Mid$(sUSADate, 7)
Dim dt As Date
ParseUSDate = VBA.DateTime.DateSerial(lYear, lMonth, lDay)
End Function
I have most of it working except....I am not sure how to combine the path and file reference to have the formula set up right.
The formula should look like "=VLOOKUP(RC1,'U:\00_Daily Reports["TPV datafile_2 - " & "myname" & ".xlsx"]TPV Data Pull'!C1:C88,36,FALSE)"
The code that I have now is:
Dim path As String
Dim file As String
Dim myformula As String
Dim myname As Date
myname = Day(Now() - 1)
path = "U:\00_Daily Reports\"
file = "TPV datafile_2 - " & "myname" & ".xlsx""
myformula = "-------------------------"
Range("CL2").Select
ActiveCell.FormulaR1C1 = myformula
I'm trying to write VBA code in Excel 2010 to make some time calculations. Everything is working as I want BUT for the cell date format. The Excel Sheets were created by merging several .xlsx files generated by different PCs and a Hardware Data-logger. The problem is that some sheets had the date as mm/dd/yy hh:mm:ss AM/PM and others dd/mm/yy hh:mm:ss AM/PM, with both mixed in one file.
I tried to change everything to Selection.NumberFormat = "dd/mm/yy hh:mm;#" but some cells just don't change. I also tried this function:
Function Arreglar_Fecha()
Dim temp As String
temp = ""
Do While ActiveCell.Value <> ""
temp = ActiveCell.Value
ActiveCell.Value = Day(temp) & "/" & Month(temp) & "/" & Year(temp) & " " & Hour(temp) & ":" & Minute(temp)
ActiveCell.Offset(1, 0).Select
Loop
End Function
But still, some cells changed, some did not. And what is worse, some get the day and month mixed!
I have access to some of the original .xlsx files and in there also wasn't able to change all the date formats.
Anyone have any idea how I can fix this?
EDIT Here I got permission for put an original Excel file Excel Data.
You will have to trace back to your source data. There is no way Excel itself knows whether 1/2/2014 for example should be the first of February or the second of January, only that it is either 41671 or 41641.
Edit In your second example, clearly 28/9/2013 17:59 is September 28. If 10/01/13 12:11:00 PM had the same formatting (perhaps came from the same file) then it is January 10. But if the formatting was different then it could be October 1. If you are seeing AMs and PMs with formatting as dd/mm/yy hh:mm;# then some of your data is text and there is no reliable 'automatic' way to switch this to a date/time serial number without knowing the text convention (ie whether DMY or MDY), hence the need to revert to source.
Obviously 'day' values greater than 12 are actually months but that does not help much when for less than 13 it depends upon the formatting.
In addition, given your various sources, there is a risk that both the 1900 and the 1904 conventions might have been used and even possibly others also (your data logger might be on UNIX time, which starts in 1970).
ActiveCell.Value = Day(temp) & "/" & Month(temp) & "/" & Year(temp) & " " & Hour(temp) & ":" & Minute(temp)
Maybe the code is reading it as text? Try this (UNTESTED)
Sub Arreglar_Fecha()
Dim temp As String, Tmp As String
Dim D As String, M As String, Y As String
Dim H As String, Mn As String
Do While ActiveCell.Value <> ""
temp = Trim(ActiveCell.Value)
D = Trim(Split(temp, "/")(0))
M = Trim(Split(temp, "/")(1))
Tmp = Trim(Split(temp, "/")(2))
Y = Trim(Split(Tmp, " ")(0))
Tmp = Trim(Split(Tmp, " ")(1))
H = Trim(Split(Tmp, ":")(0))
Mn = Trim(Split(Tmp, ":")(1))
ActiveCell.Value = Format(DateSerial(Val(Y), Val(M), Val(D)) & _
" " & TimeSerial(Val(H), Val(Mn), 0), _
"dd/mm/yy hh:mm;#")
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Trying it with a single test scenario works. The below gives you 13/08/13 05:31
Sub Test()
Dim temp As String, Tmp As String
Dim D As String, M As String, Y As String
Dim H As String, Mn As String
temp = "13/8/2013 5:31"
D = Trim(Split(temp, "/")(0))
M = Trim(Split(temp, "/")(1))
Tmp = Trim(Split(temp, "/")(2))
Y = Trim(Split(Tmp, " ")(0))
Tmp = Trim(Split(Tmp, " ")(1))
H = Trim(Split(Tmp, ":")(0))
Mn = Trim(Split(Tmp, ":")(1))
Debug.Print Format(DateSerial(Val(Y), Val(M), Val(D)) & _
" " & TimeSerial(Val(H), Val(Mn), 0), _
"dd/mm/yy hh:mm;#")
End Sub