EXCEL VBA - Date formatting - vba

Edited)
is this right? I need to do the same thign for column P. Should I do another for loop?
Dim i As Long
For i = 1 To Rows.Count
If Len(Cells(i, "Q").Value) <= 4 Then
Cells(i, 1).NumberFormat = "01/01/yyyy"
Else: Cells(i, "Q").NumberFormat = "MM/DD/YYYY"
End If
Next i
When I import excel file to access, the column that has either the years(19xx) or a full date don't display properly after imported.
The years seem fine but full date is changed to a random number like 39213, etc.
So I tried to format the whole column to text and export to access, the same thing happens.
What should I do?
The original column is in 'general' format
01/01/1962
01/01/1966
01/01/1956
1964
01/01/1943
01/01/1943
01/01/1964
1964
01/01/1972
01/01/1948
01/01/1961
01/01/1953
01/01/1961
01/01/1963
01/01/1963
01/01/1973
1960
01/01/1956
01/01/1940
1958
1958
1955
01/01/1948
01/01/1948
01/01/1970
1959
1964
01/01/1975
1966
This becomes
22647
24108
20455
1964
15707
15707
19
23377
1964
26299
17533
22282
19360
22282
23012
23012
26665
1960
20455
14611
1958
1958
1955
17533
17533
25569
1959
1964
27395
1966
And the latter column is in 'Text' format. I dont know what is wrong

EDITED TO CORRECT FORMAT ISSUE!!
Depending on which approach you want to take (A. Fix in Excel; B. Fix in Access), your solution will vary. To use your code, I modified slightly.
WARNING!! If only a year, my code will destroy content of column 1!! Change to suit your needs.
Sub Convert_Dates()
Dim lLastRow As Long
Dim i As Long
' Find last row
lLastRow = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
' Loop until last row
For i = 1 To lLastRow
If Len(Cells(i, "Q").value) <= 4 Then ' IF only a year found
Cells(i, "Q") = "01/01/" & Cells(i, "Q") ' Change date value from yyyy to mm/dd/yyyy
Cells(i, "Q").NumberFormat = "mm/dm/yyyy" ' Set format
Else
Cells(i, "Q").NumberFormat = "mm/dd/yyyy" ' Else just set format.
End If
Next i
End Sub

I think the date format should be "MM/DD/YYYY" across all the rows of "Q". I have modified your code slightly.
Sub test1()
k = Cells(Rows.Count, "Q").End(xlUp).row
Dim i As Long
For i = 1 To k
If Len(Cells(i, "Q").Value) <= 4 Then
Cells(i, "Q").Value = "01/01/" & Cells(i, "Q").Value
Cells(i, "Q").NumberFormat = "MM/DD/YYYY"
Else: Cells(i, "Q").NumberFormat = "MM/DD/YYYY"
End If
Next i
End Sub
After executing all the dates in the column "Q" will be formatted to "MM/DD/YYYY"
And if you want to keep the formatting year with 4 digits in the Q column and format that year separately in column 1, then use the below code
Sub test1()
k = Cells(Rows.Count, "Q").End(xlUp).row
Dim i As Long
For i = 1 To k
If Len(Cells(i, "Q").Value) <= 4 Then
Cells(i, 1).Value = "01/01/" & Cells(i, "Q").Value
Cells(i, 1).NumberFormat = "MM/DD/YYYY"
Else: Cells(i, "Q").NumberFormat = "MM/DD/YYYY"
End If
Next i
End Sub

Related

Add lines under condition within ranges

I kindly ask you help me on this issue.
Please look Data below:
Name StartDate EndDate
John 17.07.2016 17.07.2017
John 17.07.2017 17.07.2018
Maria 01.08.2017 01.08.2018
Chris 05.01.2018 05.01.2019
Workers and their working years. I need to add new line for worker when his/her working year finished. For example when the date > 17.07.2018 I need to add new line for John. (date = today formula)
It look like simple but this is a part of my vacation module.
I started to write code like this.
Sub AddWorkingYearLine()
Dim WorVac As Worksheet: Set WorVac = Worksheets("WorkerVacation")
Dim i As Long
Dim LRow As Long
Dim LCol As Long
Dim MyTable As Variant
LRow = Range("A1048576").End(xlUp).Row: LCol = Range("XFD4").End(xlToLeft).Column
MyTable = Range(Cells(4, 1), Cells(LRow, LCol))
For i = 1 To UBound(MyTtable, 1)
If Branches.Range("C" & i) > Range("G1") Then 'Range("G1") = today formula
End If
Next i
End Sub
Thank you all!
Here's my interpretation of your request. If column "C" of the current row occurs before today then it will insert a row, copy the current row into that new row, and then increment the year on those dates.
Sub AddWorkingYearLine()
Dim i As Long
For i = Cells(Rows.count, "A").End(xlUp).row To 4 Step -1
'make sure it's not an "old entry"
If Cells(i, "A").Value2 <> Cells(i + 1, "A").Value2 Then
'if today occurs after "end date" then
If Date > CDate(Cells(i, "C").value) And Len(Cells(i, "C").Value2) > 0 Then
'insert row
Rows(i + 1).Insert Shift:=xlShiftDown
'copy row down
Rows(i + 1).value = Rows(i).value
'update dates
Cells(i + 1, "B").value = Cells(i, "C").value
Cells(i + 1, "C").value = DateAdd("yyyy", 1, CDate(Cells(i, "C").value))
End If
End If
Next i
End Sub

LEN() returning wrong value in VBA

I have this simple data set:
230
16000
230
230000
230000
230000
16000000
230000
230000
all i want is to get the length of each cell but when i write this code:
Sub LengthOfCell()
Dim c As Long
Dim result As Integer
c = ActiveCell.Value
result = Len(c)
Debug.Print (result)
End Sub
it gives me 2 for the first cell (230) when it should be 3 and 4 for any number having more than 3 digits. dont know what i am doing wrong. tis is just for proof of concept for a larger SUB:
Public Sub SortMyData()
'approach: convert line to string and concatenate to that as it's a lot less picky than Excel's formats, then replace cell value with the new string.
' Excel will then define the string type as either Percentage or Scientific depending on the magnitude.
Dim i As Integer
Dim N_Values As Integer
N_Values = Cells(Rows.Count, 2).End(xlUp).Row
'Range("B6", Range("B5").End(xlDown)).Count
For i = 6 To N_Values 'iteration loop from 6 (first row of value) to N_Values (last filled row)
Cells(i, 3).NumberFormat = "0"
If Cells(i, 2).NumberFormat <> "0.0%" Then
Cells(i, 2).NumberFormat = "0.0%"
Cells(i, 2).Value = Cells(i, 2).Value / 100
ElseIf Len(Cells(i, 3).Value > 3) Then
Cells(i, 3).Value = Cells(i, 3).Value / 1000
ElseIf Cells(i, 3).Value = Null Then
Cells(i, 3).Value = 0
Else
Cells(i, 2).Value
Cells(i, 3).Value
End If
' If Len(Cells(i, 3) > 3) Then
' Cells(i, 3).Value = Cells(i, 3).Value / 1000
' ElseIf Cells(i, 3).Value = Null Then
'Cells(1, 3).Value = 0
' Else
' Debug.Print
' End If
Next
End Sub
The closing ) is in the wrong place.
If Len(Cells(i, 3).Value > 3) Then
should be
If Len(Cells(i, 3).Value) > 3 Then
Len(Cells(i, 3).Value > 3) will evaluate to Len("True") or Len("False"), so it will always be True (any non-zero number is True)
Len is a String type function
#Shai Rado, please, be careful with such statements in answers for newbies...
F1: Len Function
Returns a Long containing the number of characters in a
string or the number of bytes required to store a variable.
Not sure why you're including the Dim c As Long piece at all - why not try this:
Sub LengthOfCell()
Dim result As Integer
result = Len(ActiveCell.Value)
Debug.Print (result)
End Sub
That works fine for me..
Since you are looking for the number of characters (digits) in the cell, you need to change to Dim c As String and modify your code a little, it will give you the Result that you are looking for.
See short-sub below:
Sub LengthOfCell()
Dim c As String
Dim i As Long
Dim result As Integer
For i = 1 To 9
c = CStr(Cells(i, 1).Value)
result = Len(c)
Debug.Print result
Next i
End Sub
There seems to be a confusion between Value and Display Text. Range().Value will return the ranges raw value, where as, Range().Text or Cstr(Range().Value) will return the formatted value.
Sub Demo()
Dim r As Range
For Each r In Range("A2:A9")
r.Value = 230
r.Offset(0, 1) = r.NumberFormat
r.Offset(0, 2) = Len(r.Value)
r.Offset(0, 3) = Len(r.Text)
r.Offset(0, 4) = Len(CStr(r.Value))
Next
End Sub

Outputting recurring events within a loop VBA

I am currently analyzing a schedule with color coded events that occur in a row and the time expands over the columns (there is only color in the cells no text, yes it's dumb but it's out of my control). I am currently able to print the result for one occurrence of an event into another worksheet, but I cannot determine how to make it print the dates for recurring events in different cells (it currently only prints the last time an event occurs). My current code is:
For i = 2 To 93
If Cells(7, i).Interior.Color = "8421631" And Cells(7, i - 1).Interior.Color = "16777215" Then
startDay = Cells(3, i).Value
startMonth = Cells(1, i).Value
name = Cells(7, i).Value
Worksheets("Sheet1").Activate
ActiveWorkbook.Worksheets("Sheet1").Cells(2, 1) = startDay + startMonth
End If
If Cells(7, i).Interior.Color = "8421631" And Cells(7, i + 1).Interior.Color = "16777215" Then
endDay = Cells(3, i).Value
endMonth = Cells(1, i).Value
ActiveWorkbook.Worksheets("Sheet1").Cells(2, 2) = endDay + endMonth
End If
Next i
All of my variables are entered as strings. I attempted a few different methods with no success. I feel that I need to add another loop in my IF statement, but I am unsure as to how to best do it. Overall the code achieves its purpose (previously used message boxes for output to confirm it was operating as it should). This is just a small part of the overall code, but with this answer I would be able to apply it elsewhere.
for what I could grasp out of your description you may try this code:
Option Explicit
Sub main()
Dim i As Long
For i = 2 To 93
If Cells(7, i).Interior.Color = "8421631" Then
If Cells(7, i - 1).Interior.Color = "16777215" Or Cells(7, i + 1).Interior.Color = "16777215" Then
WriteDate Cells(3, i).Value, Cells(1, i).Value
End If
End If
Next i
End Sub
Sub WriteDate(day As String, month As String)
With ActiveWorkbook.Worksheets("Sheet1")
.Cells(2, .Columns.Count).End(xlToLeft).Offset(, 1) = day & "/" & month
End With
End Sub

convert a date format for over 500 rows using a For Next Loop

I need to convert dates (up to last row) in column "C" from the existing format 24/01/2016 to 24.01.2016 The result has to be in date format.
My current code is:
LastRow9 = ws5.Cells(Rows.Count, "C").End(xlUp).Row
For X9 = 1 To LastRow9
searchvalue = Cells(X9, "C").Value
Answer = Split(searchvalue, "/")
ws5.Cells(X9, "A").Value = Answer
ws5.Cells(X9, "A").Value = Format(Answer, "dd.mm.yyyy")
Next X9
the answer i get is 30.12.1899 a bit off the mark
Try changing the Range.NumberFormat property.
with ws5
.range(.cells(1, "C"), .Cells(Rows.Count, "C").End(xlUp)).NumberFormat = "dd.mm.yyyy"
end with

'If ... Then' statement with loop

I've what seems like a pretty simple application with looping and 'If..Then' statements but need some help on structuring it.
In very a basic example, I have a list numbers in column A and the values PM or AM listed in column B. I want to write a loop that will search every value in column B until the end of the data set, and add 12 to each value in column A each time column B has a value of PM. In a nutshell, it would look like this:
If column B = PM
then add 12 to its corresponding cell in column A
else move down to the next row and do the same thing until you reach an empty cell
There are many ways, here is a typical one:
Sub dural()
Dim i As Long
i = 1
Do While Cells(i, "B").Value <> ""
If Cells(i, "B").Value = "PM" Then
Cells(i, "A").Value = Cells(i, "A").Value + 12
End If
i = i + 1
Loop
End Sub
you can set it with For next loop and 2 variables. one for last row and the 2nd for the row count:
Sub Macro1()
Dim LastRow As String
Dim i As Integer
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow
If Cells(i, 2).Value = "PM" Then Cells(i, 1).vlaue = Cells(i, 1).vlaue + 10
Next i
End
'
End Sub
This is another way to do this.
Option Explicit
Sub Add()
Dim rData As Range
Dim r As Range
Set rData = Cells(1, 1).CurrentRegion.Columns("B").Cells
For Each r In rData
If UCase$(r.Value) = "PM" Then
r.Offset(, -1).Value = r.Offset(, -1).Value + 12
End If
Next r
End Sub