Ms Access series numbering that resets monthly and yearly - vba

I ran into a problem with my code.
My MS Access Database needs to reset the series number field at the beginning of a new month or year.
However when testing the database it works well until i get to the 10th record and afterwards i receive a duplicate value warning.
I'm totally confused on where i went wrong.
Please help? Code is pasted below:
Private sub form_beforeinsert(Cancel as integer)
dim vlast as variant
dim invnext as integer
me.invyear = format(date,"yyyy") & format(date, "mm")
vlast = dmax("SeriesNumber", "invoice", "InvYear='" & Me.invyear.value & "'")
if isnull(vlast) then
invnext = 1
else
invnext = vlast + 1
end if
me.seriesnumber = invnext
me.invoicenumber = format(date, "yyyy") & "-" & Format(date, "mm") & "-" Me.SeriesNumber
End Sub

It is because you seem to store everything as text. So, convert to a number to retrieve the numerical maximum value:
vlast = DMax("Val([SeriesNumber])", "invoice", "InvYear='" & Me!invyear.Value & "'")

Related

Save As to Variable File Paths

Trying to use an Excel-macro that will automatically save the workbook once certain cells are filled in. The macro will check when changes are made to specific cells, then use variable data to save the workbook through a folder system organized by year and quarter, while giving the Workbook a name based on the Current date and a cell number. The macro will also check to see if the network path (it being on a server) is connected, and if not, exit the sub. I am getting a compile error "Expected: end of statement" at
Set mTitle = Year(Now)," & . & ", Month(Now), " &.& ", Day(Now), " & - & ", ActiveWorkbooks.Sheets("Control").Cells(1, "C")
I want to save the workbook with the following format: Year.Month.Day - CellValue, but it looks like VBA doesn't like periods. How can I solve this? Full code below.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cYear As String
Dim Quarter As String
Dim fdObj As Object
Dim mTitle As String
Dim sCheck
Application.ScreenUpdating = False
Set cYear = Year(Now)
Set Quarter = (Month(Now) + 2) \ 3
Set fdObj = CreateObject("Scripting.FileSystemObject")
sCheck = "S:\Estimating Data\Estimates\test.txt"
Set mTitle = Year(Now)," & . & ", Month(Now), " &.& ", Day(Now), " &.& ", ActiveWorkbooks.Sheets("Control").Cells(1, "C")
If Intersect(Target, Range("C1:C5")) Is Nothing Then
Exit Sub
Else
If WorksheetFunction.CountA(Range("C1:C5")) = 0 Then
Exit Sub
Else
Shell ("Net View \\S:\ > " & vsFileName)
If FileLen(vsFileName) = 0 Then
Exit Sub
Else
If fdObj.FolderExists("S:\Estimating Data\Estimates\" & cYear & "\""Q" & Quarter & ".*xlsm") Then
ActiveWorkbook.SaveAs Filename:="S:\Estimating Data\Estimates\" & cYear & "\""Q" & Quarter & "\" & mTitle & ".*xlsm"
Else
fdObj.CreateFolder ("S:\Estimating Data\Estimates\" & cYear & "\""Q" & Quarter & ".*xlsm")
End If
End If
End If
End If
End Sub

Calendar settings interfere with [dateReceived] filter

I'm trying from Excel to scan a shared inbox for emails with attachments, which were received on a certain date. The aim is to save the attachments and import them into the workbook running the code.
Here's the code I have so far adapted from Download attachment from Outlook and Open in Excel to scan the inbox and print some info on the emails it finds
Sub extractEmailDetails()
Dim oOlAp As Object, oOlns As Object, oOlInb As Object, oOlInp As Object
Dim oOlItm As Object
Dim strDateFrom As String, strDateTo As String
Dim searchDate As Date
searchDate = #12/9/2015# 'mm/dd/yyyy
strDateFrom = "'" & Format(searchDate, "dd/mm/yyyy") & "'"
strDateTo = "'" & Format(searchDate + 1, "dd/mm/yyyy") & "'"
'~~> Get Outlook instance
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInp = oOlns.Folders("SHR-Cust Ops MI Team Inbox")
Set oOlInb = oOlInp.Folders("Inbox")
'~~> Store the relevant info in the variables
For Each oOlItm In oOlInb.Items.Restrict("[attachment] = True AND [receivedTime] > " & strDateFrom & " AND [receivedTime] < " & strDateTo)
Debug.Print oOlItm.ReceivedTime & " " & oOlItm.Subject
Next
End Sub
When I search for the 8th of December it only brings back emails that were received after 8am.
I changed the settings for working hours in the calendar to midnight to midnight (no working hours) and the code then brought back all emails for the specified date. However, I can't leave my calendar with no working hours. Is there a way to change the default behaviour to ignore the working hours?
It sure sounds like your are getting GMT + your local time zone offset.
What is your TZ?
After messing around with this a little I've found a solution. A very obvious one. You can't just provide the date, you also need to provide a time, so:
[...]
strDateFrom = "'" & Format(searchDate, "dd/mm/yyyy") & "'"
strDateTo = "'" & Format(searchDate + 1, "dd/mm/yyyy") & "'"
Becomes
[...]
strDateFrom = "'" & Format(searchDate, "dd/mm/yyyy hh:mm") & "'"
strDateTo = "'" & Format(searchDate + 1, "dd/mm/yyyy hh:mm") & "'"

VBA Excel - Importing from Access and Summing Data

I am using a userform in excel to allow users to import claims data from an Access database and paste it into a destination in the workbook.
The code below allows the user to import claim numbers for each of the last 5 years for a particular policy number.
The access database currently summarizes claims data so that all the claims for policy Y in year Y are on one row. However, I need to change the code so that the individual claim amounts can be pulled in and then adjusted based on parameters set out in the userform (i.e. capping claims at 100,000) and then summarized so that all the (adjusted claims) are on a single row for each year.
I have included an image of what the database structure looked like before and what it looks like now. I would like to include something that loops over all the claims in an underwriting year and sums up the total.
database
Without getting into too much detail, I would like know how to summarize the data after I have adjusted them. Do I need another loop in the code below?
Public Const RawdataDB = "N:\***\Rawdata DB.accdb"
Private Sub CommandButton1_Click()
Dim dbRawData As Database
Dim rTemp As Recordset
Dim sSQL As String
Dim YearTemp As Integer
Dim i As Integer
i = 1
Do Until i = 6
YearTemp = Year(Range("RenewalDate")) - i
Set dbRawData = OpenDatabase(RawdataDB, False, False, "MS Access;PWD=*****")
sSQL = "SELECT Galway_Claims.* FROM Galway_Claims WHERE (Galway_Claims.PolicyNo=" & Range("PolicyNoNew") & " AND Galway_Claims.Year=" & Range("UWYear") - 1 & " AND Galway_Claims.HistoricYear=" & i & ");"
Set rTemp = dbRawData.OpenRecordset(sSQL)
Controls("ClaimNos" & i).Value = Format(rTemp!ClaimNosD, "0.0")
i = i + 1
Loop
rTemp.Close
End Sub
The easiest here seems to sum everything in access: Make another query:
sSQL = "SELECT Sum(Galway_Claims.ClaimAmts) as theSum FROM Galway_Claims WHERE (Galway_Claims.PolicyNo=" & Range("PolicyNoNew") & " AND Galway_Claims.Year=" & Range("UWYear") - 1 & " AND Galway_Claims.HistoricYear=" & i & ");"
And then read this in like before:
sSQL = "SELECT Galway_Claims.* FROM Galway_Claims WHERE (Galway_Claims.PolicyNo=" & Range("PolicyNoNew") & " AND Galway_Claims.Year=" & Range("UWYear") - 1 & " AND Galway_Claims.HistoricYear=" & i & ");"
Set rTemp = dbRawData.OpenRecordset(sSQL)
Controls("ClaimNos" & i).Value = Format(rTemp!ClaimNosD, "0.0")
sSQL = "SELECT Sum(Galway_Claims.ClaimAmts) as theSum FROM Galway_Claims WHERE (Galway_Claims.PolicyNo=" & Range("PolicyNoNew") & " AND Galway_Claims.Year=" & Range("UWYear") - 1 & " AND Galway_Claims.HistoricYear=" & i & ");"
Set rTempSum = dbRawData.OpenRecordset(sSQL)
Controls("ClaimNos" & i).Value = Format(rTempSum!theSum, "0.0")
...

error 1004 when trying to set cell value to value of string

I've seen this question a few times but haven't found a solution that is applicable to my situation, so here it goes:
I have a fairly complicated formula that I want to insert into a cell (complicated as in it's a pain in the butt to follow). I have the components set up in variables, and running the sub give me the correct final variable name in the locals window, however when I try to set the cell to the formula I get a '1004: application-defined or object defined error'. the output should look like this:
Cell A1: =BDS("0","pg_segment","dir = h", "number_of_periods = -3")
However it returns nothing.
I have tried the following: setting the final variable (cmdstr0) to an integer-- this works. As a string ("asdf") also works. Altering the value directly (.value = "string") works. The only thing that doesn't work is when VBA builds the formula itself to insert into the string. Here's the code, and thank you:
sub populate_revenues()
'field = bloomberg field to look up
'direction = output direction (horizontal/vertical)
'geoverride = override to display only geo or product segments
'periods = numbe of periods to display
'cmdstr = the string to be output that will download the data
Dim field As String
Dim direction As String
Dim geoverride As String
Dim periods As String
Dim cmdstr3 As String
Dim cmdstr2 As String
Dim cmdstr1 As String
Dim cmdstr0 As Variant
Let cmdstr2 = 0
Let field = Worksheets("output").Cells(1, 3).Value
Let direction = "Dir = " & Worksheets("output").Cells(1, 5).Value
Let geoverride = " product_geo_override = " & Worksheets("output").Cells(1, 7).Value
Let periods = " number_of_periods = " & Worksheets("output").Cells(2, 3).Value
Let cmdstr1 = "=BDS(" & Chr(34)
Let cmdstr3 = Chr(34) & "," & Chr(34) & field & ", " & Chr(34) _
& direction & Chr(34) & ", " & Chr(34) & geoverride & Chr(34) & ", " & Chr(34) & periods & Chr(34) & ")"
Let cmdstr0 = cmdstr1 & cmdstr2 & cmdstr3
'Let cmdstr0 = 1
Let Worksheets("Sheet2").Cells(10, 1).Value = cmdstr0
End Sub
Also, can anyone please tell me if there's a faster way to format as code than hitting space-bar four times every line?
As you know, you must double-up on the double quotes. So if you want:
=COUNTIF(A1:A10,"apples")
you must use:
Sub demo()
Range("B9").Formula = "=COUNTIF(A1:A10,""apples"")"
End Sub
I, personally, have a lot of trouble with this. What I do to debug is to place an apostrophe at the start of the formula:
Sub demo()
Range("B9").Formula = "'=COUNTIF(A1:A10,""apples"")"
End Sub
This allows me to "see" the text of the formula and fix problems.
B.T.W
To create a code block, hi-light the code and use the paired braces {}

Using COUNTIF in VBA with last row

I'm quite new to excel and have been trying to get this Countif formula to work for a while now. I want it to count from the 12th row in column AN p till the last used row. I am very close now but when I run the macro it gives me a REF error.
Sub Date1()
'
' Enter Date
'
Range("B15") = InputBox("Enter Date")
Dim LR As Long
LR = Sheets("Design Risk Scoring Sheet").Range("AN" & Rows.count).End(xlUp).Row
Range("B16").FormulaR1C1 = _
"=COUNTIF('Design Risk Scoring Sheet'!R[-4]C[38]:RC[38](" & LR & "), ""<"" & R[-1]C )"
End Sub
This is what i get in the formula cell when I run the macro
=COUNTIF('Design Risk Scoring Sheet'!AN12:AN16(163), "<" & B15 )
It should ideally be AN163 instead of 16. I have tried removing RC[38] and putting AN instead but i get AN(163) which gives a #NAME error and if i remove the brackets in (" & LR & ") then I get single quotation marks in the formula :
=COUNTIF('Design Risk Scoring Sheet'!AN12:'AN163', "<" & B15 )
I dont know how to fix this problem?
Alternate:
Sub Date1()
Dim sDate As String
sDate = InputBox("Enter Date", "Date Entry", Format(Now, "m/d/yyyy"))
If Len(sDate) = 0 Then Exit Sub 'Pressed cancel
If Not IsDate(sDate) Then
MsgBox "[" & sDate & "] is not a valid date.", , "Exiting Macro"
Exit Sub
End If
Range("B15").Value2 = DateValue(sDate)
Range("B16").Formula = "=COUNTIF(AN12:AN" & Cells(Rows.Count, "AN").End(xlUp).Row & ",""<""&B15)"
End Sub
Try This..
Range("B16").FormulaR1C1 = _
"=COUNTIF('Design Risk Scoring Sheet'!R[-4]C[38]:RC[38](" & LR & "), < & R[-1]C )"