here is the situ ation I have many sheets all displaying the same columns in the same order and they have different data in them, Im trying to write a Macro to insert a column next to the cost one and to create a runing summ or incremental sum, this column will then be copied to a new sheet later on. After a tries I have managed to get close to my goal, the problem is that my macro does the same calculation over and over again, without summing the cost column. it gets clearer if you look at the code I'm posting below. all help to solve the problem would be appreciated.
Sub IncCost()
Dim r As Range
Set r = ActiveSheet.Range("A1").CurrentRegion
Columns("H:H").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H1").FormulaR1C1 = "Incremental cost"
Range("H2").FormulaR1C1 = Cells(2, 7)
Range("H3").FormulaR1C1 = "=" & Cells(3, 7) & "+" & Cells(2, 8)
Range("H3").AutoFill Destination:=Range("H3:H" & r.Rows.Count)
End Sub
Perhaps:
Range("h3:h" & r.rows.count).formular1c1 = "=RC[-1]+R[-1]C"
Related
Hi Guys Its Great to be here. I am stuck with a problem in making sequenced serial with condition in MS Access. Let's say i have number of machines working for 2 shifts. Every shift i receive a report of downtime for each machine and the same machine in the same shift could have more than one problem. My goal is to count those problems and make a sequenced serial for it. For Example i made it in Excel with countifs formula and working good - see the picture. 4 Conditions (PoNumber-Shift-MachineNumber-Zdate)
I tried everything I know in Access and got stuck. I tried Count(IIf()) but did not get the desired result and the way to do it is a recordset function and I don’t have the ability to do it. Any Help Appreciated Guys.
Edit #1 : Guys i have tried the following before
SELECT TblDownTime.PONumber, TblDownTime.Zdate, TblDownTime.Shift, TblDownTime.MachineNumber AS MachineNum, Count(TblDownTime.Shift) AS CountOfShift
FROM TblDownTime
GROUP BY TblDownTime.PONumber, TblDownTime.Zdate, TblDownTime.Shift, TblDownTime.MachineNumber
HAVING (((TblDownTime.PONumber)=[Forms]![FrmDownTime]![PONum]) AND ((TblDownTime.Zdate)=[Forms]![FrmDownTime]![Zzdate]) AND ((TblDownTime.Shift)=[Forms]![FrmDownTime]![Shift]) AND ((TblDownTime.MachineNumber)=[Forms]![FrmDownTime]![MachineNumber]));
This is a query which apply my conditions and return the last serial of each downtime reason As variable (Sr) in the form. Then after update in MachineNumber field in the form Me.Serial = Sr+1. This way works fine with one by one record but when i try to paste 20 records at the time it miscalculates and giving me duplicates sometimes. So it is not the best way to go. I need a way which work fine with pasting multiple records at the time. Thanks again.
Edit #2 i use the generated serial to be formatted like this "Num"&Serial to be like Num1,Num2 to use in the following query
SELECT TblDownTime.PONumber, TblDownTime.Zdate, TblDownTime.Shift, TblDownTime.MachineNumber,
IIf([SerialFormat]="Num1" And [MachineNumber]=[MachineNumber],[ReasonCode],"") AS Code1,
IIf([SerialFormat]="Num1" And [MachineNumber]=[MachineNumber],[Reason],"") AS Reason1,
IIf([SerialFormat]="Num1" And [MachineNumber]=[MachineNumber],[DepartmentResponsible],"") AS Dept1,
IIf([SerialFormat]="Num1" And [MachineNumber]=[MachineNumber],[StoppedFrom],"") AS From1,
IIf([SerialFormat]="Num1" And [MachineNumber]=[MachineNumber],[StoppedTo],"") AS To1,
IIf([SerialFormat]="Num1" And [MachineNumber]=[MachineNumber],[TotalDownTime/Min],"") AS TotalDownTime1
FROM TblDownTime
WHERE (((IIf([SerialFormat]="Num1" And [MachineNumber]=[MachineNumber],[ReasonCode],""))<>""));
i will try the other way in comments tomorrow, And i will be grateful if someone helps me with a recordset function that operates directly on the table and i will but it on OnClose Event in my form .. thanks a lot
Here is a procedure to consider. Call from whatever event best meets your needs.
Sub MakeNum()
Dim rs As DAO.Recordset, intS As Integer, strG As String
Set rs = CurrentDb.OpenRecordset("SELECT PONumber & MachineNumber & ZDate & Shift AS Grp, ReasonSerial " & _
"FROM tblDowntime WHERE ReasonSerial Is Null ORDER BY PONumber, MachineNumber, ZDate, Shift, ID")
strG = rs!grp
While Not rs.EOF
If strG = rs!grp Then
intS = intS + 1
rs.Edit
rs!ReasonSerial = intS
rs.Update
rs.MoveNext
Else
intS = 0
strG = rs!grp
End If
Wend
End Sub
It only edits new records where ReasonSerial is Null. If you need to recalculate sequence for all records then include an UPDATE at beginning of procedure:
CurrentDb.Execute "UPDATE tblDowntime SET ReasonSerial=Null"
I am developing an Access database (using Office 2016) and have several tab controls which I want to display the number of records in the subform/subreport.
After a lot of searching etc I have it working for the subforms using a function which I call in the main forms current event (but in a seperate function so I can also call via a macro when I change the main forms record with a combo box, as it wasn't updating otherwise). The code I am using is:
Function ClientTotals()
Dim i As Integer
i = Form_sbfrm_ClientContacts.Recordset.RecordCount
Form_frm_Clients.ClientTabs.Pages("Contacts").Caption = "Contacts (" & i & ")"
End Function
This works perfectly for me and my tab name becomes "Contacts (No. of records)" but I can't get the syntax right to change this to work for a report, is it possible?
I have tried:
Function ClientTotals()
Dim i As Integer
i = Form_sbfrm_ClientContacts.Recordset.RecordCount
Form_frm_Clients.ClientTabs.Pages("Contacts").Caption = "Contacts (" & i & ")"
Dim j As Integer
j = Report_rpt_CurrentProjects.Recordset.RecordCount ' this line is highlighted with the debugger
Form_frm_Clients.ClientTabs.Pages("Current Projects").Caption = "Current Projects (" & j & ")"
End Function
As well as:
Dim j As Integer
j = rpt_CurrentProjects.Report.Recordset.RecordCount ' this line is highlighted with the debugger
Form_frm_Clients.ClientTabs.Pages("Current Projects").Caption = "Current Projects (" & j & ")"
and various others.
Another question I have is why is the syntax for the form "Form_sbfrm" etc and not using a "!". If I change to "!" it bugs out.
Thanks for your help, KAL
Thanks Delecron,
I think I will stick with the tabs for now as they are giving me exactly what I want, but remember what you have said for when I make future improvements if its a better way of doing it.
EDIT
Using what you have said I changed my VBA to a DCOUNT method:
Dim j As Integer
j = DCount("*", "qry_CurrentProjects", "FK_Project_Client_ID = Forms!Navigation!Navigationsubform.form!Client_ID")
Form_frm_Clients.ClientTabs.Pages("Current Projects").Caption = "Current Projects (" & j & ")"
This means my report tabs are now also working just how I wanted
I was getting in a muddle with the criteria/filter, hense the edit.
If Recordset is an old method I am assuming it would be best to replace my other code with the Dcount method?
Thanks again, KAL
Further EDIT
After doing this I could see that everytime the form was changed there was a slight flicker. Not bad but you could see there was a lot of calculation going on. Therefore I have changed my method to the following, and posted here for anyone looking at this in the future.
In the form footer a textbox with COUNT([Project_ID])
In my function
Dim j As Integer
j = Form_frm_Clients!rpt_CurrentProjects.Report!txt_CurrentProjectsCount.Value
Form_frm_Clients.ClientTabs.Pages("Current Projects").Caption = "Current Projects (" & j & ")"
Now I can see it is working quicker with no flicker.
Recordset if you need to return complex data, if you need one value, a total or a sum, Domain functions are the way to go. Don't overdue them though, having too many on a form or a report can start to bog down usability.
Glad I can help.
Recordset.Recordcount is a legacy feature that only worked in ADP files (Access front end's to a SQL database). Those are no longer supported.
If the report is based on 1 client only and there is no grouping then you can do this:
Click on the detail section and in Events create an event for On Paint. In there set
(Name of Page).Caption = DCount("*", "NAME OF QUERY/TABLE") or
(Name of Page).Caption = DCount("*", "NAME OF QUERY/TABLE", "Filter Expression") (Filter expression optional).
If the report is grouped where it will show a different page per client or date range or any other grouping this will not work since the Caption field is not data bound. You would have to add logic to the Dcount statement above to field by the current filter condition.
For example, say you have a database of 200 clients and you're running one big report on all of them, each page will get its own tab control per client, the syntax would be
(Name of Page).Caption = DCount("*", "ClientContacts, "ClientID = " & ClientID)
The better way to do it especially if you are grouping is get rid of the tab control and use databound controls. You could create a box around the information that would be in the tab page and put a textbox where the tab would go. Create a group header for however you are grouping the data. Create another invisible textbox in the group header and set the controlsource = Count([fieldname]) where fieldname is whatever you are grouping the data by (the inside brackets count).
Then in the textbox you created to simulate the tab, set the controlsource to the name of the invisible textbox.
Let me know if this helps.
I am having a most frustrating time time with the DoCmd.TransferSpreadsheet method. I have a workbook with multiple worksheets in which users are updating data and I have a script that puts all the records back into a single sheet, links the spreadsheet, and updates the data in my Access DB. My problem is in the Range parameter. I pass the following string and get the following error:
DoCmd.TransferSpreadsheet TransferType:=acLink, SpreadsheetType:=acSpreadsheetTypeExcel12Xml, _
TableName:=linkSheet, fileName:=Wb.Path & "\" & Wb.name, _
HasFieldNames:=True, Range:="AccessUpdate!updateTable"
The Microsoft Access database engine could not find the object 'AccessUpdate$updateTable'. Make sure the object exists and that you spell its name and the path name correctly. If 'Access_Update$updateTable' is not a local object, check your network connection or contact the server administrator.
I can't seem to understand why it substitutes the dollar sign for the bang. Any other help in understanding how to specify the range would also be appreciated.
Thanks!
I know this is an year old question but it is an almost timeless problem.
I'm trying to do the same from the Excel side and bumping into the same problem. Access switching the sheet separator "!" for "$"
I found that this is a bug from Access 2000 that was never corrected. Or better, it was partially corrected at some point. So depending on your Access build and the size of the range [yes, size, since this is a bug from Access 2000] the solutions provided by Cisco or HansUp will work.
Another sources explaining the problem and a similar solution is provided by the MS$ themselves
https://answers.microsoft.com/en-us/office/forum/office_2007-access/transferspreadsheet-error-3011-can-not-file-sheet/980b2dc1-9ee1-4b3e-9c3c-a810f1428496
with the help of Bob Larson Former Access MVP (2008-2010) [see his very last post]
Now, if your range is on a different sheet with more than 65536 rows, this bug will come back.
See here for reference
Funny enough, if this is Sheet1 [yes, index 1 of all sheets] it will work with any range size. But any other sheet it wil fail.
This was my original range: BASE!A2:X68506, named REF_ACCESS. BASE is my Sheet5. Access 2010 & Excel 2010
I tried ActivateSheet, assign to string inside command, assign to string outside command, replace(,"$","!""), nothing worked. Even on Office 2016 from a friend
If I use "BASE!A2:X64506", it works. If I use "A2:X68506", Access assumes Sheet1 and works. Attention that all ranges do not have "$", but I guess you already know that
My last test was something like this monster
DoCmd.TransferSpreadsheet TransferType:=acImport, SpreadsheetType:=9, TableName:="TEST", Filename:=ThisWorkbook.FullName, HasFieldNames:=False, Range:=Worksheets("BASE").Name & "!" & Replace(Left(Worksheets("BASE").Range("REF_ACCESS").Address, Len(Worksheets("BASE").Range("REF_ACCESS").Address) - 1), "$", "")
A test that using my range within the 65536 row limit [6553 to be precise] would work. And it did.
So I see solutions with only two options for now. Either copy your range to Sheet1 or another sheet, as RyanM did, or divide your range in multiple DoCmd with 65536 rows.
I know it is long. Sorry, this was 2 full days looking for an answer without any real solution. I hope this helps other people with the same problem.
I tried multiple methods for getting around this without making major modifications to my code but with no avail. I did come up with a solution but it is rather resource intensive and messy. However, in case someone has a similar issue, I will post it here. I wound up separating my update sheet into it's own file from the rest of the workbook and linking that file. This prevented Access from trying to link a different sheet and got me around the whole Range issue. I know it's not elegant or efficient but it worked. If I figure out a cleaner way I'll post it here.
Set xl = Wb.Parent
xl.ScreenUpdating = False
xl.DisplayAlerts = False
strFile = mypath & "\TempIss.xlsx"
For i = 1 To Wb.Worksheets.count
If InStr(1, Wb.Worksheets(i).name, "Update", vbTextCompare) > 0 Then
tableId = i
Exit For
End If
Next i
If tableId = 0 Then
MsgBox "This workbook does not seem to have the necessary worksheet for updating " & _
"the Participant Issues Log in Access.", vbInformation, "Uh oh..."
Exit Function
Else
Set upWs = Wb.Worksheets(i)
upWs.Select
upWs.Copy
xl.ActiveSheet.SaveAs fileName:=strFile
xl.ActiveWorkbook.Close
Call rmSheet(Wb, "AccessUpdate")
xl.ScreenUpdating = True
linkSheet = "tempIssLog"
DoCmd.TransferSpreadsheet TransferType:=acImport, SpreadsheetType:=acSpreadsheetTypeExcel12Xml, _
TableName:=linkSheet, fileName:=strFile, _
HasFieldNames:=True
Kill (strFile)
If the range is a named range (in Excel) follow the instruction above (HansUp comment).
If the range is defined in MS-Access be sure to pass a string (something like "A1:G12") and not the control name.
Dim StrRange as variant
Dim NameofMySheet as string
NameofMySheet = "xxxxxx" ' <- Put here the name of your Excel Sheet
StrRange = NameofMySheet & "!" & "A1:G12"
DoCmd.TransferSpreadsheet TransferType:=acLink, SpreadsheetType:=acSpreadsheetTypeExcel12Xml, _
TableName:=linkSheet, fileName:=Wb.Path & "\" & Wb.name, _
HasFieldNames:=True, Range:= StrRange
Note 1: StrRange with no quotes!
I have a spreadsheet that's used to connect to my mySQL database and make changes to that database. I think the way I'm checking for duplicates in the system is very inefficient, but I'm having a hard time thinking of a more efficient way of doing this. The time it takes to go item by item isn't that long with 100 items, but it's VERY long with 50,000 items, and I'm trying to find a way to shorten the amount of time this process takes.
In Excel
'/ Define last row with data in it
lastRow = Range("C" & Rows.Count).End(xlUp).Row
'/ go through each row, line by line, to check if this part number is in the system
For c = 5 To lastRow Step 1
'/ Based on user input, runs a SELECT query to see if the part number in question is already in the table they're trying to upload into
SQLStr = "SELECT quotePartNumber FROM " & table & " where (quotePartNumber, `debitNumber) IN (('" & partNumber & "', '" & debitNum & "')) LIMIT 1"`
rs.Open SQLStr, conn, adOpenStatic
' Dump to spreadsheet
With Worksheets("DATA").Range("N28:N28")
.ClearContents
'/ copy SQL output to cell N28, then check if an output exists. If the part exists in the table already, a part number will fill N28, if the part doesn't exist, N28 will be blank.
.CopyFromRecordset rs
End With
'/ If the part already exists, delete this part number from the spreadsheet.
pnCheck = Range("N28").Value
If pnCheck <> "" Then
Range(Cells(c, 1), Cells(c, 11)).Select
Selection.Delete Shift:=xlUp
deleted = deleted + 1
c = c - 1
End If
'/ reset rs for the next run through
rs.Close
Set rs = Nothing
Range("N28") = ""
debit = False
next c
So basically, I go through each line in the spreadsheet, check to see if that part exists already in my table, and if it does, I delete that line from the spreadsheet. Once the list is whittled down to what's NOT in the table already, I upload it (that code is not shown here...)
Is there a more efficient way of checking anywhere from 5,000 to 100,000 part numbers against a table than going line by line?
Sorry, misunderstood initially.
How does mySQL respond if you try to upload the table with duplicate IDs? The field should be defined as requiring unique values if that's what it needs, and I think MySQL would just throw a warning and dump the offending rows.
That aside, this is something Excel can do faster than you repeatedly querying, writing, deleting, and updating. Can you dump ALL the table's IDs to your spreadsheet in a different sheet? Then you could use Excel's countif formula and delete anything with more than 1. I'm on a phone so it's hard to be specific but have a countif next to each spreadsheet ID, and count if it's in the range of mySQL IDs. Then filter for > 1 and delete. You could also dump the ids into one column, use an adjacent column to track what was spreadsheet and what was db, use excel's remove duplicates, then delete the db entries. All that's left are the uniques spreadsheet entries.
In general, for performance, selection and modification is slow. Instead of selecting a range and deleting the selection, delete the range outright. Deleting and shifting is slow too, so maybe just flag the offending rows in an adjacent column, then delete them all at once. Also, turn off screenupdating, application.screenupdating = false. Updating the screen is slow too.
Hey all, I managed to integrate my Database quite well with Excel in the end, but in the end after I showed it to the bosses they asked me to develop the forms and reports in Access again. That did not take too long fortunately, so I ended up doing two front ends for one back end Database. But in the end it'll be a fully Access database with only one bit of Excel integration utilized; basically the transfer spreadsheet method to transfer daily end of trade Share price into Access.
Now I've come to a point where the database is pretty much ready to be split and populated.(What's the best way to tackle this, populate first or split first?)
The question I'm asking is below:
This might seem like a fairly simple question but so far, I haven't been helped with google or maybe I'm not using the right keywords in my search so I thought what better place to ask then on here; Is there a way to format the numbers that are generated through some VBA code and placed in a new table in Access, to make them look like:
So if it's 1,000,000 then it would appear as 1m
Or if it's 10,000 then it appears as 10k
So basically if it has three 0's then it's a K
If it has six 0's then it's an M
I have used some VBA initially to format the numbers in the following way:
ChangeInShare = Format(ChangeInShare, "#,##.00")
But then the request came to shorten some numbers down to make the reports look neater.
The final table, takes the values in a Text format btw.
Thank you
You can use the modulo operator to test if the number is dividable by 1000000 or by 1000 and then replace the last zeros.
Maybe this function points you to the right direction:
Public Function fmt(val As Long) As String
Dim result As String
If val Mod 1000000 = 0 Then
result = (val \ 1000000) & "M"
ElseIf val Mod 1000 = 0 Then
result = (val \ 1000) & "K"
Else
result = val
End If
fmt = result
End Function
Then some test calls:
? fmt(471000)
471K
? fmt(4711)
4711
? fmt(4000000)
4M
? fmt(40000)
40K
Hi Muffi D
additional to vanjes acceptable very good answer there is another idea:
what about the scientific notation?
Debug.Print FStr(10)
Debug.Print FStr(2000)
Debug.Print FStr(300000)
Debug.Print FStr(40000000)
Debug.Print FStr(5000000000#)
Debug.Print FStr(12)
Debug.Print FStr(2345)
Debug.Print FStr(345678)
Debug.Print FStr(45678901)
Debug.Print FStr(5678901234#)
Function FStr(ByVal d As Double) As String
FStr = Format(d, "0.####E+0")
End Function
then you will get:
1,0E+1
2,000E+3
3,E+5
4,E+7
5,E+9
1,2E+1
2,345E+3
3,4568E+5
4,5679E+7
5,6789E+9
if you need for Doubles (or Currency) you can go with vanjes answer but use the ModF-function instead:
Function ModF(ByVal value As Double, _
ByVal div As Double) As Double
ModF = value - (Int(value / div) * div)
End Function
Function fmtF(ByVal value As Double) As String
Dim result As String
If ModF(value, 1000000000) = 0 Then
result = (value / 1000000000) & "G"
ElseIf ModF(value, 1000000) = 0 Then
result = (value / 1000000) & "M"
ElseIf ModF(value, 1000) = 0 Then
result = (value / 1000) & "K"
Else
result = value
End If
fmtF = result
End Function
regards
Oops
You can split your database anytime before distribution to your users but I don't know what you mean by "populate."
See the "Splitting your app into a front end and back end Tips" page for info on splitting.. See the free Auto FE Updater utility to make the distribution of new FEs relatively painless.
I was also wondering; I have a CurrencyCode which defines whatever type of currency the Company is in; now all the calculations in VBA are done already. I wanted to know is there a way to write a SQL statement where for example; if the CurrencyCode=GBP then the resultant field is displayed as £23m instead of 23m etc for all the different currencies that are there in the field.
This again, needs to be hard-coded right now; the only thing is, if in the future if I'm not with the company, someone has to add a company in, which doesn't have the code to do that; then what will be the way to deal with? Will they have to have someone that needs to know about how to use SQL or VBA and be able to change; for this I would prefer doing it in SQL if possible because then I could put this in a manual for the database and SQL is much less daunting to use then VBA for beginners.
The resultant values have to be in the same column, so all the different IF's and Wheres need to be part of the same SQL statement, this is because of the reports that are there which use a single column for the different companies with different currencies.
Thanks!