Cannot change the format after concatenating dates in Excel VBA - excel

I have dates formatted as text. I want to change these dates' format from
"dd.mm.yyyy hh:mm" to "yyyy.mm.dd". (eg. "04.05.2020 10:33" to "2020.05.04") I use the following code (the original dates are in column "K"):
Dim cell As Range
For Each cell In Range(Range("K2"), Range("K2").End(xlDown))
cell.Offset(0, 7).Value = Mid(cell.Value, 7, 4) & "." & Mid(cell.Value, 4, 3) & Left(cell.Value, 2)
Next
The newly created dates cannot be formatted, though and so when I try to use a vlookup function on them, the function fails, saying it couldn't find the value in the lookup table. (dates are ok in the lookup table)
I need to manually enter every cell and hit enter and only after that will excel start recognizing the format.
I also found that if I use the manual "replace" function of excel like this: https://i.stack.imgur.com/U3k5e.png, and replace the dots with dots, excel will once again start to recognize the format, however it won't recognize any format when I use the following code:
Range(Range("R2"), Range("R2").End(xlDown)).Replace What:=".", Replacement:=",", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Can someone help? How can I convert the format of these concatenated values in vba so that vlookup will recognize them?
Thanks!

Try this:
cell.Offset(0, 7).Value = Format(Mid(cell.Value, 7, 4) & " " & Mid(cell.Value, 4, 3) & " " & Left(cell.Value, 2), "yyyy.mm.dd")
The yyyy.mm.dd at the end tells it how you want it formatted. You also need to use a space or a slash (/) between the 3 functions because it doesn't recognize a period as a separator for it.
For example formatting the month. Take January:
m = 1
mm = 01
mmm = Jan
mmmm = January
Edit:
The only way I could see really doing it then is:
Dim cell as range
For Each Cell in Range(Range("K2"), Range("K2").End(xlDown))
Cell.Value = Format(Replace(Cell.Value,".","/"), "yyyy.mm.dd")
Next

Convert Date & Time As String to Date
Option Explicit
Sub createDate()
Dim Data As Variant
Dim currString As String
Dim currDate As Date
Dim i As Long
With Range(Range("K2"), Range("K2").End(xlDown))
Data = .Value
For i = 1 To UBound(Data, 1)
currString = Data(i, 1)
currDate = DateSerial(CLng(Mid(currString, 7, 4)), _
CLng(Mid(currString, 4, 2)), CLng(Left(currString, 2)))
Data(i, 1) = currDate
Next i
With .Offset(, 7)
.Value = Data
.NumberFormat = "yyyy.mm.dd"
'.Columns.AutoFit
End With
End With
End Sub

I ended up using the following code:
For Each cell In Range(Range("K2"), Range("K2").End(xlDown))
cell.Offset(0, 7).Value = Mid(cell.Value, 7, 4) & "/" & Mid(cell.Value, 4, 2) & "/" & Left(cell.Value, 2)
Next
Turns out I just had to use slashes to separate the concatenated parts, this allowed me to freely change the formatting of the newly created dates.
Special thanks to Simon, his answers helped a lot!

Related

Excel vba: Convert String to Datetime add it to new Column

So I have cells containing strings of date, such as:
14/04/2019 10:13:18 AM
how can I convert it to DateTime using vba?
I've tried using .NumberFormat but some of the cells got converted and some didn't:
My code is
Sub ConvertToDateTime()
With Range("Data[Modified On]")
.NumberFormat = "dd/mm/yyyy hh:mm:ss AM/PM"
.Value = .Value
End With
End Sub
And how do I insert converted value to a new column?
I've created a new column with:
Dim Table As ListObject
Dim newColNum As Integer
Set Table = ActiveSheet.ListObjects("Data")
Table.ListColumns.Add.Name = "New Header"
Can I do it without looping?
Some of the cell do got converted but some don't
That's because the date format on your PC is different than the data (it is mm/dd/yyyy while the data is in "dd/mm/yyyy")
This can't be fixed without looping. (as far as I know)
To fix that, you might need to do something like this:
Sub ConvertToDateTime()
Dim Cell As Range, h As Long, c As Long
Range("Data[New Header]").NumberFormat = "dd/mm/yyyy hh:mm:ss AM/PM"
c = Range("Data[New Header]").Column
For Each Cell In Range("Data[Modified On]")
If Right(Cell.Value, 2) = "PM" Then h = 12 Else h = 0
Cells(Cell.Row, c).Value = DateSerial(Mid(Cell.Value, 7, 4), Mid(Cell.Value, 4, 2), Left(Cell.Value, 2)) + _
TimeSerial(Mid(Cell.Value, 12, 2) + h, Mid(Cell.Value, 15, 2), Mid(Cell.Value, 18, 2))
Next
End Sub

Converting larges number of values to UK date format in Excel VBA

I have a sheet with tens of thousands of dates in the following format :-
31.01.2018 (so, dd.mm.yyyy)
The cell format of each of these is General. I need to convert each of these to UK date format.
To do so, I am using :-
With ThisWorkbook.Worksheets("Report")
For i = 2 To Lastrow
DateString = .Range("J" & i).Value
Year = Right(DateString , 4)
Month = Mid(DateString , 4, 2)
Day = Left(DateString , 2)
With .Range("J" & i)
.Value = CDate(Day & "/" & Month & "/" & Year)
.NumberFormat = "dd/mm/yyyy"
End With
Next i
End With
This takes quite a while, and I wanted to know if there was a more effective way of converting the dates?
If i understand correctly and I am not missing something, you don't need VBA to do that.
Just select column J and find and replace . with /.
If you want to do it using VBA anyway, you can do this:
Sub test()
Dim sht As Worksheet
Dim rng As Range
Set sht = ThisWorkbook.Worksheets("Report")
Set rng = sht.Columns("J")
rng.Replace what:=".", replacement:="/"
End Sub
It takes less than a second to execute for around 10k dates.
EDIT:
When it's done the values will be recognized by excel as dates.
The format of these dates can be set to the European one. Select column J press CTRL+1, in the Number tab, under Category choose Date and set it to European format.
Or simply add this line to he code above:
rng.NumberFormat = "dd/mm/yyyy"
I was able to resolve this using the answer supplied here :-
https://stackoverflow.com/a/30609676/1936588
Changing
.TextToColumns Destination:=.Cells(1), DataType:=xlFixedWidth, FieldInfo:=Array(0, xlYMDFormat)
To
.TextToColumns Destination:=.Cells(1), DataType:=xlFixedWidth, FieldInfo:=Array(0, xlDMYFormat)

Creating exact dates in Excel VBA by inputing only the day

In the following picture of an Excel sheet, the heading of the first column, and then of every 7th column after that, contains a month and a year.
I am trying to think of some code which would make entering complete dates under these headings faster. Since the month and the year are already present, I'm thinking there must be a way to enter just the day, and get the whole thing. For example, if "21" were entered in cell A26, "2/21/2015" would result.
Anyone have an idea for how I might get this output?
Edit: Thanks to the helpful replies on this forum, I figured out exactly how to do this. Here is the code for my finished product, in case anyone wants to do something similar:
Private Sub Worksheet_change(ByVal Selection As Range)
Set Sel = Selection
If Sel.Count > 1 Then
Exit Sub
End If
If (Sel.Column - 1) Mod 7 = 0 Or Sel.Column = 1 Then
'In my case, date columns always follow the pattern of 1, 8, 15...
If Sel.Value > 31 Or Sel.Value = "" Then
Exit Sub
Else
Sel.NumberFormat = "General"
Sel.Value = Left(Cells(1, Sel.Column), InStr(Cells(1, Sel.Column), ",") - 1) & " " & _
Sel.Value & Right(Cells(1, Sel.Column), 6)
Selection.NumberFormat = "m/d/yyyy"
End If
End If
End Sub
How about entering the day numbers, selecting the range where these day numbers are entered, and running the below:
Sub Add_month_year()
Dim c As Range
For Each c In Selection
c = Left(Cells(1, c.Column), InStr(Cells(1, c.Column), ",") - 1) & " " & _
c.Value & Right(Cells(1, c.Column), 6)
Next
End Sub
This should return the full dates in date code, which you can then format as you see fit.

Concatenating SumIfs in VBA

I'm trying to get this segment of code to execute. This is a simplified version of the code. I've included the relevant code. I'm trying to concatenate strings and named ranges into a SumIfs formula, but I get error 1004 "Application-defined or Object-defined error." I have a working line of code above this problem section that is similar with the exception of doing a sum function, instead of sumif. Any idea how to get this code to execute? Thank you.
Dim wb As Workbook
Dim ara As Worksheet
Dim inv As Worksheet
Dim ARBlock As Range
Dim Invoices As Range
Dim AgedDays As Range
Set wb = ThisWorkbook
Set ara = wb.Sheets("AR Aging")
Set inv = wb.Sheets("Invoices")
Set ARBlock = ara.Range("a6")
Set Invoices = inv.Range("a6", inv.Range("a6").End(xlDown))
Set AgedDays = Invoices.Offset(0, 6)
'Populate A/R age buckets
For i = 6 To ARBlock.Rows.Count + 6
With ARBlock(i - 5, 1).Offset(0, 3)
.Value = "=SumIfs(" & Invoices.Offset(0, 4).Address & "," & _
Invoices.Address & "," & ARBlock(i - 5, 1).Value & "," & _
Invoices.Offset(0, 6).Address & ","" <= "" & &O30)"
End With
Next i
End Sub
The line beginning with ".value" is where I'm getting the error message. P.S.: I need the cell to contain the concatenated formula, as opposed to the output value.
UPDATE 1:
As some suggested I updated the .value line to:
.Offset(0, 3).Formula = "=SumIfs(Invoices.Offset(0, 4).Address,Invoices.Address,ARBlock.cells(i - 5, 1).Value)"
I'm still getting the same error. Some auditing I've done:
Removing the "=" before "Sumifs" allows the code to run fine; pasting in the formula into the target cell as text. In this form, my output for i=1 goes to ARBlock.cells(1,1), as it should.
I also used Debug.Print to view all of the components of the formula:
Debug.Print ARBlock.Cells(i - 5, 1).Address
'output $A$6
Debug.Print ARBlock.Cells(i - 5, 1).Value
' output International Business Machines
Debug.Print Invoices.Offset(0, 4).Address
'output $E$6:$E$255
Debug.Print Invoices.Address
'output $A$6:$A$255
I suspected the issue might be that the range dimensions might have been off, but this is not the case. My next suspicion is that the output International Business Machines needs to be in " " for the formula to read it correctly. I hardcoded in
""International Business Machines""
to see if this would fix the formula, but I keep getting the same error once I add the "=" back in. The formula syntax is correct, the dimensions are the same between the sum range and criteria range. Anyone else have any ideas?
.Offset(0, 3).Formula = "=SumIfs(Invoices.Offset(0, 4).Address,Invoices.Address,ARBlock.cells(i - 5, 1).Value)"
Change to:
.Offset(0, 3).Formula = "=SumIfs(" & Invoices.Offset(0, 4).Address & ", " & Invoices.Address & ", " & chr(34) & ARBlock.Cells(i - 5, 1).Value & chr(34) & ")"
EDIT: Added quotes chr(34) around your string!
Your ARBlock(i - 5, 1).Value most likely is an empty cell, which messes the SUMIFS formula as it builds it with to consecutive commas

EXCEL VBA - Similar function to excel formula Value

I'm new to VBA so I got a problem trying to convert some string number to a value number for a IF validation.
The problem is. I have Column "A" filled with something like this:
E/B: Houses 01
E/B: Houses 02
E/B: Building/New Villa
E/B: Building/Bella Casa
E/B: Houses 03
So, in my code, I want it to fill the "B" Column with the last 2 numbers if there's numbers or the name if there isn't.
Set Rng = Range("A8:A" & Range("I" & Rows.Count).End(xlUp).Row)
For Each celula In Rng.SpecialCells(xlCellTypeVisible)
Select Case True
Case IsNumeric(Right(celula, 2)) = True
celula.Offset(0, 1).Value = Right((celula), 3)
Case Else
celula.Offset(0, 1).Value = Mid(celula, InStr(4, celula, "/") + 1, Len(celula))
End Select
Next celula
But the Case IsNumeric(Right(celula, 2)) = True is never True. It do not capture the 2 last numbers. But it works alright with the names and returns "New Villa" and "Bella Casa". And I think the problem is that Right(celula, 2) is never a number, even if theres a number.
I want to know if theres a way to convert "Right(celula, 2)" in a Value, just like the =Value formula in excel, to do the validation.
OBS: Before trying this way, I had a excel formula applied to those cells and it worked, but I want to try this way for learning purposes.
Thanks
I think the for each loop itself works as expected.
However, this
Set Rng = Range("A8:A" & Range("I" & Rows.Count).End(xlUp).Row)
is probably where the problem lies. You have to make sure you've got the correct Range. You can verify by debugging: Debug.print Rng.Address.
Sub t()
Dim rng As Range
With ActiveSheet
Set rng = .Range("a1:a" & .Range("a" & .Rows.Count).End(xlUp).Row)
For Each cell In rng.Cells
If Val(Right(cell.Value, 2)) = 0 Then
cell.Offset(0, 1) = Mid(cell.Value, InStrRev(cell.Value, "/") + 1, Len(cell))
Else
cell.Offset(0, 1) = Val(Right(cell.Value, 2))
End If
Next cell
End With
End Sub

Resources