In the following code, CalendarMonths is a range containing month names. endDate is also a range.
I need to translate those names into month numbers, however the following method using Month function returns "type mismatch" error (even if I skip CInt):
For Each CalendarMonth In CalendarMonths
If CInt(Month(CalendarMonth)) = CInt(Month(endDate)) Then
If you have a month as String and want to convert to Long:
Sub skjdffhs()
Dim s As String, n As Long
s = "January"
n = Month(CDate("1 " & s & " 2000"))
MsgBox n
End Sub
(this is for the US locale)
Related
I have a word table. I wrote a macro to get values from the table. When it runs I get a runtime error 13. When I debug and watch the value of parsing string it looks like this "2019-04-03 There is only one quote in the string. I think that is the case I couldn't convert that string into a date format. Can you help me to fix this?
The code
Sub Macro2()
Dim NumRows As Integer
Dim startDate As String
Dim days As String
Dim endDate As String
If Not Selection.Information(wdWithInTable) Then
Exit Sub
End If
NumRows = Selection.Tables(1).Rows.Count
'Loop to select each row in the current table
For J = 2 To NumRows
'Loop to select each cell in the current row
startDate = Selection.Tables(1).Rows(J).Cells(5).Range.Text
days = Selection.Tables(1).Rows(J).Cells(6).Range.Text
FormatDate = CDate(ends)
endDate = DateAdd("d", days, FormatDate)
Selection.Tables(1).Rows(J).Cells(7).Range.Text = endDate
Next J
End Sub
The table
Here's the minimal change I found that works for me when tested in Word 2013.
General points:
I added Option Explicit so that the computer would help me find errors. In this case, the variables J and FormatDate were used but not Dimed, and ends was used but never initialized (I changed it to startDate).
The Range.Text in a table cell includes whitespace and the end-of-table marker (¤). That is why CDate was giving an error.
For the dates, I used Left() to take only the left ten characters, since you seem to always be using yyyy-mm-dd-format dates.
For the counts of days, since those can be of any length, I used Range.Words(1).Text to keep only the first Word (as MS Word defines it), which is the number.
I also added the CLng() call in the parameter to DateAdd, since DateAdd wants a number* rather than a string.
For production use, I would also recommend using Selection only in one place, and doing Dim workTable as Table: Set workTable = Selection.Tables(1). That will simplify your code.
Code
<=== marks changed lines
Option Explicit ' <==
Sub Macro2()
Dim NumRows As Integer
Dim startDate As String
Dim days As String
Dim endDate As String
If Not Selection.Information(wdWithInTable) Then
Exit Sub
End If
NumRows = Selection.Tables(1).Rows.Count
'Loop to select each row in the current table
Dim J As Long ' <==
For J = 2 To NumRows
'Loop to select each cell in the current row
startDate = Selection.Tables(1).Rows(J).Cells(5).Range.Text
startDate = Left(startDate, 10) ' <== Remove the space and table mark
days = Selection.Tables(1).Rows(J).Cells(6).Range.Words(1).Text ' <===
Dim FormatDate As Date ' <==
FormatDate = CDate(startDate) ' <== not `ends`
endDate = DateAdd("d", CLng(days), FormatDate) ' <=== clng
Selection.Tables(1).Rows(J).Cells(7).Range.Text = endDate
Next J
End Sub
* DateAdd actually takes a Double, but VBA can promote Long to Double. I chose CLng since it looks like you are only using integer day spans. If not, use CDbl instead.
Try:
Sub Demo()
Dim r As Long
With Selection
If Not .Information(wdWithInTable) Then Exit Sub
With .Tables(1)
For r = 2 To .Rows.Count
.Cell(r, 7).Range.Text = _
Format(DateAdd("d", Split(.Cell(r, 6).Range.Text, vbCr)(0), CDate(Split(.Cell(r, 5).Range.Text, vbCr)(0))), "YYYY-MM-DD")
Next r
End With
End With
End Sub
I have a comment field with cells containing text like this:
Cancelled by user at 2018-01-03 03:11:57 without charge
I want to get the date and time information, but it may not always be in the 3rd/4th from last spaces, otherwise I might try to do some sort of complicated split of the cell. Is there an "in cell" way extract the date time information? Or will this need a VBA script? I prefer the former, but I'm trying to make a macro to simplify my life anyway, so VBA would work too.
I'd propose the following formula:
=MID(A1,FIND("at 20",A1)+3,19)
This would require that the date is always preceded by the word 'at' and the date string starts with 20.
You can try this function. It splits the string checking for items that have the first letter numeric, and builds a result string of just the date information.
Public Function ParseForDate(sCell As String) As String
Dim vSplit As Variant
Dim nIndex As Integer
Dim sResult As String
vSplit = Split(sCell, " ")
For nIndex = 0 To UBound(vSplit)
If IsNumeric(Left$(vSplit(nIndex), 1)) Then
sResult = sResult & vSplit(nIndex) & " "
End If
Next
ParseForDate = Trim$(sResult)
End Function
If you wanted to use it in a formula it would look something like this:
=ParseForDate(A1)
To use it in a VBA routine:
Dim s as String
s = ParseForDate(Range("A1"))
Non-VBA solution: (this is assuming the date format is always the same for all cells)
= MAX(IFERROR(DATEVALUE(MID(A1,ROW(INDEX($A:$A,1):INDEX($A:$A,LEN(A1)-19)),20)),0))
+MAX(IFERROR(TIMEVALUE(MID(A1,ROW(INDEX($A:$A,1):INDEX($A:$A,LEN(A1)-19)),20)),0))
Note this is an array formula, so you must press Ctrl+Shift+Enter instead of just Enter when typing this formula.
You will obviously then need to format the cell as a date and time, but this formula gets the numerical value that Excel uses for its internal date and time system.
Using a regex will enable you to fetch the date and time, irrespective of its placement in the string. The following solution will work if the date and time are of the same format as shown in the example string.
Code:
Sub getDateTime()
Dim objReg, matches, str
str = Sheet1.Cells(1, 1).Value 'Change this as per your requirements
Set objReg = CreateObject("vbscript.regexp")
objReg.Global = True
objReg.Pattern = "\d{4}(?:-\d{2}){2}\s*\d{2}(?::\d{2}){2}"
If objReg.test(str) Then
Set matches = objReg.Execute(str)
strResult = matches.Item(0)
MsgBox strResult
End If
End Sub
Click for Regex Demo
Regex Explanation:
\d{4} - matches 4 digits representing the year
(?:-\d{2}){2} - matches - followed by 2 digits. {2} in the end repeats this match 2 times. Once for getting MM and the next time for DD
\s* - matches 0+ whitespaces to match the space between the Date and Time
\d{2} - matches 2 digits representing the HH
(?::\d{2}){2} - matches : followed by 2 digits. The {2} in the end repeats this match 2 times. First time for matching the :MM and the next time for matching the :SS
Screenshots:
Output:
This will be good for about 90 years (using cell C3 for example):
Sub GetDate()
Dim s As String
s = Range("C3").Comment.Text
arr = Split(s, " ")
For i = LBound(arr) To UBound(arr)
If Left(arr(i), 2) = "20" Then
msg = arr(i) & " " & arr(i + 1)
MsgBox msg
Exit Sub
End If
Next i
End Sub
I've written some VBA code with two matches and index formula. I need to pick the unique value from a sheet and compare it with the other sheet. However it is not working. I get some errors. (unable to get the match property of the worksheetfunction class vba - this is the error)
Here is my code :
Sub Post_Attendance()
Sheets("DB").Activate
'On Error Resume Next
Dim myvalue As String
Dim mydate As String
Dim mypost As String
(the date value entered in a cell)
Dim Dt As String
Dt = Range("C7").Value
(the unique id entered in a cell)
Dim empid As String
empid = Range("C8").Value
(activating another worksheet , from a cell value)
Dim strWsName As String
strWsName = Sheets("DB").Range("A7")
Sheets(Left(strWsName, 3)).Select
(match function to find the row and columns number for indexing)
mydate = WorksheetFunction.Match(Dt, Range("B1:Q1"), 0)
myvalue = WorksheetFunction.Match(empid, Range("A5:A500"), 0)
mypost = WorksheetFunction.Index(Range("B2:Q6"), myvalue, mydate)
End Sub
First off, WorksheetFunction.Match never returns a string; it either returns a number (a long integer) or an error. It is not the value from the match, it is the row or column number where the match was found.
Next, you cannot catch an #N/A error from no match with WorksheetFunction.Match but you can catch it with Application.Match into a variant.
Real dates are numbers, not strings. The raw underlying value is another long integer; e.g. a positive whole number with no decimal portion. If you had time or a datetime then you would have a decimal portion.
Resolve and reference your parent worksheet properly; do not rely upon Select or Activate.
The number returned from MATCH is the position within the range of cells searched. You are looking for a row number from row 5 to row 500 then using that to find a row within row 2 to 6; any match above row 9 (match returning 6 or above) in the original is going to be out-of-range.
If the empid values are numbers then deal with numbers; you cannot find a match to a true number from text-that-looks-like-a-number; e.g. 99 <> "99". I'm going to assume that empid should be alphanumeric and not a true number but given the errors with the previous variable assignments, it is up to you to determine the correct assignment.
Here is my best guess at an error controlled sub procedure (given that you have shown no sample data).
Option Explicit
Sub Post_Attendance()
'On Error Resume Next
Dim myvalueRow As Variant, mydateCol As Variant, dt As Long, empid As String, mypost As Variant
dt = Worksheets("DB").Range("C7").Value2
empid = Worksheets("DB").Range("C8").Value2
With Worksheets(Left(Worksheets("DB").Range("A7").Value2, 3))
'locate the column for the date
mydateCol = Application.Match(dt, .Range("B1:Q1"), 0)
If IsError(mydateCol) Then _
mydateCol = Application.Match(CStr(Worksheets("DB").Range("C7").Value2), .Range("B1:Q1"), 0)
If IsError(mydateCol) Then
Debug.Print "dt not found in row 1"
Exit Sub
End If
'locate the row for the value
myvalueRow = Application.Match(empid, .Columns("A"), 0)
If IsError(myvalueRow) Then
Debug.Print "empid not found in column A"
Exit Sub
End If
mypost = Application.Index(.Range("B:Q"), myvalueRow, mydateCol)
End With
End Sub
I need to create a lot number which consists of:
Digits: 1,2,3 ----> Three digit reagent code ----> For example:141 (this is a constant)
Digit: 4 ----> Identifier ----> For example: 2 (this is a constant)
Digits: 5,6,7 ----> Julian/Ordinal Calendar day ----> 001-365 (366 for leap year)
Digit: 8 ----> The last digit of the expiry year ----> 0-9
Therefore: 14120039 (Expiry date would be 2019-01-03)
The expiry date can be found on a sheet called "CP_sequencer" in cell "S7". This will be in the format yyyy-mm-dd.
The following is the code I’m using so far but I know something is wrong and it may not be the most efficient way of doing things. There are a few cell references that are correct but I know it may be hard to follow without the actual spreadsheet.
Dim Julian_Day As String
Dim Split_Date As String
Dim valueYear, valueLastDigit As Integer
Range("F31").Select
Julian_Day = _
ActiveCell.FormulaR1C1 = _
"=VALUE(RIGHT(YEAR('CP sequencer'!R[-24]C[13]),2)&TEXT('CP sequencer'!R[-24]C[13]-DATE(YEAR('CP sequencer'!R[-24]C[13]),1,0),""000""))"
Split_Date = _
Range("F31") = Year(CP_Sequencer.Range("S7"))
Range("F31").Select
Select Case Len(value1) 'gives a number depending on the length of the value1
Case 4 ' e.g., 2017 = 201, 7
valueYear = Left(value1, 3) ' 201
valueLastDigit = Right(value1, 7) ' 7
End Select
ActiveCell.Value = "1412" & Julian_Day & valueLastDigit
I know something isn't right because at the moment when I run this code the output is 1412False0
Any help would be much appreciated
I assume you want a VBA solution to write back your lot number code to a given cell. Your code includes many errors (references without values, undeclared variables, double assignments and so on). Maybe the code with explainations below will be of some help. I use a type Definition to structure your results and make the code more readable.
Code
Option Explicit ' obliges you to declare your variables
Type TData ' declaration head of your module
ReagentCode As String ' 3 dig .. 141
ID As String ' 1 dig .. 2
JulDays As String ' 3 dig .. 1-365/366
YearDigit As String ' 1 dig .. 7 (2017 -> 7)
End Type
Sub CreateLotNo()
' Declare variables
Dim MyData As TData
Dim yr As Integer ' expiry year extracted from cell Sz
Dim ws As Worksheet
' set fully qualified reference to your worksheet
Set ws = ThisWorkbook.Worksheets("CP Sequencer")
' get expiry year from cell S7
yr = Year(ws.Range("S7").Value) ' expiry year
With MyData
' assign values to MyData
.ReagentCode = "141" ' constant
.ID = "2" ' constant
' julian days = expiry date minus last year's ultimo date
.JulDays = Format(ws.Range("S7").Value - CDate("12.31." & yr - 1), "000")
.YearDigit = Right(yr, 1) ' last digit of the expiry year
' write lot number back to cell XY
ws.Range("F31").Value = .ReagentCode & .ID & .JulDays & .YearDigit & ""
End With
End Sub
This should return the LotNumber you're after.
I'm quite not sure what's wrong with your code, but it will be in this line:
Julian_Day = _
ActiveCell.FormulaR1C1 = _
"=VALUE(RIGHT(YEAR('CP sequencer'!R[-24]C[13]),2)&TEXT('CP sequencer'!R[-24]C[13]-DATE(YEAR('CP sequencer'!R[-24]C[13]),1,0),""000""))"
This is asking the question is the formula in the activecell the same as the text string "=VALUE(RIGHT...." and place the result in the Julian_Day variable. Pretty much guaranteed that the value won't be the same so FALSE is returned.
If you wanted to get the result of the formula using that method you'd need to place the formula in the cell first and then read the result... but I'd advise against using that method. Easier to reference the values within VBA.
The LotNumber function below should return the value you're after. You can use it as I have in the Test procedure or as a worksheet function entered directly in a cell: =LotNumber(A1,B1,C1)
Sub Test()
'Passing values to the LotNumber function.
Debug.Print LotNumber(141, 2, DateValue("3 January 2019"))
'Getting values from Sheet1.
With ThisWorkbook.Worksheets("Sheet1")
Debug.Print LotNumber(.Range("A1"), .Range("B1"), .Range("C1"))
End With
End Sub
Public Function LotNumber(Reagent As Long, Identifier As Long, Expiry As Date) As String
Dim Ordinal As Long
Ordinal = Expiry - DateSerial(Year(Expiry), 1, 1) + 1
LotNumber = Format$(Reagent, "000") & Identifier & Format$(Ordinal, "000") & Right(Format(Expiry, "yyyy"), 1)
End Function
Edit:
As an afterthought you could define the LotNumber function as:
Public Function LotNumber(Expiry As Date, Optional Reagent As Long = 141, Optional Identifier As Long = 2) As String
Using this method you must pass the date to the function, but the Reagent and Identifier will default to 141 and 2 if no alternative values are supplied.
If entered today (30th November 17) then Debug.Print LotNumber(Date) will return 14123347. As a worksheet function with 3rd Jan 2019 in cell C1: =LotNumber(C1) will return 14120039
I am trying to create a function, for use in subs, that creates an array of actual days in a month. I am unable to run the function by using either the Immediate window directly or with a sub. The function's code is the following (Debug.Print instances are removed, as they never even trigger):
Function GenererDager(ByVal month As Integer, ByVal year As Integer) As Integer
Dim dateFormat As String, daysArr() As Integer, actualDays As Integer
actualDays = 1
' Find the number of actual days in given month
For dayCheck = 1 To 31
dateFormat = month & "/" & dayCheck & "/" & year ' mm/dd/yyyy format
If IsDate(dateFormat) Then
actualDays = actualDays + 1
Else
Exit For
End If
Next dayCheck
' Redimension the array with the actual number of days in the month
ReDim daysArr(actualDays)
' Populate the array with the correct number of days
For daysToArray = 1 To actualDays
daysArr(daysToArray) = daysToArray
Next daysToArray
GenererDager = daysArr
End Function
Running the function using the Immediate window with GenererDager(2, 2017) produces the following error message: Compile error: Expected: =
Running the function using the Immediate window with ?GenererDager(2, 2017) produces the following error message: Compiler error: Type mismatch with the very last usage of daysArr selected
The test-sub I'm using to call the function looks like this:
Sub HentDager()
Dim daysArray() As Integer
daysArray = GenererDager(2, 2017)
Debug.Print daysArray(4)
End Sub
Calling this sub in the Immediate window with HentDager() produces the following error: Compile error: Expected: =
I have been pretty much stuck on this problem for a while now, and I have been rewriting the code several times to identify the issue(s), but so far I have been unable to solve it. I might have produced more errors than what I have fixed in the process, as it have dawned on me that I have no clue what I'm really doing right now :-)
You have to declare your objects and function as Variant to pass arrays.
Further more, your function needed a few changes :
actualDays = actualDays - 1 because you returned the 1st value for which it isn't a date!
ReDim daysArr(1 To actualDays) to avoid having an empty value on the 1st index of the array,
which would have been daysArr(0)
Working function (tested):
Function GenererDager(ByVal month As Integer, ByVal year As Integer) As Variant
Dim dateFormat As String, daysArr() As Variant, actualDays As Integer, dayCheck As Integer, daysToArray As Integer
actualDays = 1
' Find the number of actual days in given month
For dayCheck = 1 To 31
dateFormat = month & "/" & dayCheck & "/" & year ' mm/dd/yyyy format
If IsDate(dateFormat) Then
actualDays = actualDays + 1
Else
Exit For
End If
Next dayCheck
actualDays = actualDays - 1
' Redimension the array with the actual number of days in the month
ReDim daysArr(1 To actualDays)
' Populate the array with the correct number of days
For daysToArray = 1 To actualDays
daysArr(daysToArray) = daysToArray
Next daysToArray
GenererDager = daysArr
End Function
Tests :
Sub HentDager()
Dim daysArray() As Variant
daysArray = GenererDager(2, 2017)
'Display last day of the month in the immediate window
Debug.Print daysArray(UBound(daysArray))
End Sub
After a bit of trial and error, here is an example using Integer :
Sub TestIntSub()
Dim TestInt() As Integer
TestInt = FctIntArr
Debug.Print TestInt(1) & "|" & TestInt(2)
End Sub
Public Function FctIntArr() As Integer()
Dim IntArr() As Integer
ReDim IntArr(1 To 2)
IntArr(1) = 545
IntArr(2) = 232
FctIntArr = IntArr
End Function
You need to define the return type of the function correctly -
Function GenererDager(ByVal month As Integer, ByVal year As Integer) As Integer
Change it to
Function GenererDager(ByVal month As Integer, ByVal year As Integer) As Variant
few things that seems to be wrong are
your return value of the function is actually dimmed as an integer rather than as integer()
instead of dimming the daysarray as array just dim it as a variant and assign the value