I'm building a workbook to re-rate products based on proposed rates. I have three tabs, one which rates the products, one which stores the rates for each variable, and another with the product data. The goal of the VBA is to re-rate every customer on the data tab with the new rates. The product data tab is set up the following way: Index, variable 1, variable 2...charge. The rating tab is set up to look up the index and re-rate it based on the variables. The VBA works by running through each index and pasting it to the rating tab. How can I speed up the macro? It looks something like this:
Set wa = ActiveWorkbook.Sheets("Rate")
Set ws = ActiveWorkbook.Sheets("Data")
lRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 to lRow:
Application.ScreenUpdating = False
wa.Range("L86") = ws.Range("BZ" & i).Value 'this is where the index is copied
ws.Range("BL" & i) = wa.Range("M65").Value 'this is a new re-rated attribute
ws.Range("BM" & i) = wa.Range("N65").Value 'this is a new re-rated attribute
Next i
Related
I am trying to build an Access db of inspection data for mass manufactured plastic parts from a bunch of Excel sheets, which come from different sources.
I am doing this with two Access files: one as the front end/UI (Forms and Macros), and one as the back end (Tables containing the desired data).
My process:
Use front end Access Form to open the msoFileDialogFilePicker and select an Excel sheet of data to get read into my back end Access Table. The Table where the data is stored in the back end file depends on radio buttons selections in the front end file Form.
Macro reads data from Excel sheet, transposes data, and stores it in a new dumpSheet at the end of the original data file. Each row in this dumpSheet is effectively its own record in the corresponding back end Access table. Data gets read into back end Access Tables using DAO.Database and DAO.Recordset.
Repeat with new inspection data as it comes in every two weeks.
The inspection data comes from different sources, but it can be for the same plastic part. This combination of company + part dictates which fields are of interest to be read into the recordset. For example, all of these combinations would have different fields (each combination has its own table), but there is new inspection data for each combination every two weeks (hence the need for a db):
Company X + Part A
Company X + Part B
Company Y + Part A
Company Y + Part B
Here is a general look at how I'm setting this up in the Access front end Form Macro (where the fields listed in the Do While Loop are for one specific Company + Part combination:
Set excelTemp = New Excel.Application
excelTemp.Visible = True
excelTemp.DisplayAlerts = True
Set trExcelWB = excelTemp.Workbooks.Open("myExcelData.xlsx") 'Picked from msoDialogFilePicker
Dim ws As Worksheet
Set ws = trExcelWB.Sheets(Sheets.Count)
Dim dbDump As DAO.Database
Set dbDump = DBEngine.Workspaces(0).OpenDatabase("backend-database.accdb")
Dim dumpTable as String
dumpTable = "myTableForDataInBackEndDB"
Dim tdf As DAO.TableDef
Set tdf = dbDump.TableDefs(dumpTable)
Dim rst As DAO.Recordset
Set rst = dbDump.OpenRecordset(Name:=dumpTable)
With rst
.AddNew
Dim n as Integer
n = 2
Do While Len(ws.Cells(n,5).Value) > 0 '5th column of dumpSheet stores unique part IDs and governs end of my dataset on the dumpSheet
.AddNew
![Date of Inspection] = ws.Cells(n, 2).Value
![Date of Production] = ws.Cells(n, 3).Value
![LOT] = ws.Cells(n, 4).Value
![Serial] = ws.Cells(n, 5).Value
![Part] = ws.Cells(n, 6).Value
![Depth] = ws.Cells(n, 7).Value
![Wall thickness] = ws.Cells(n, 8).Value
.Update
n = n + 1
Loop
Which works in the case where I have:
Date of Inspection
Date of Production
LOT
Serial
Part
Depth
Wall Thickness
As my field names. These are my headers in only one case of many.
I would like something like this in my Do While Loop:
Do While Len(ws.Cells(n,5).Value) > 0
Dim col as Integer
For col = 2 To ws.UsedRange.Columns.Count
.AddNew
![dbDump.TableDefs(dumpTable).Fields(col - 1).Name] = ws.Cells(n, col).Value
Next col
.Update
n = n + 1
Loop
I get an Error
"Item not found in Collection".
I'm confused because dbDump.TableDefs(dumpTable).Fields(col - 1).Name on its own gives me the name of the field I want as a string, but I cannot figure out how to call it in the dbDump from this code.
I've looked and can't figure out how to loop through field names via index and not name.
I have a macro with all tasks I have to do to generate a report, currently I need merge new data from the new sheet to the original. Some sort of JOIN if we could call it like that.
In the srcWorkbook we have things like address, who was in charge in that time and a date/id timestamp. In the outWorkbook there's vendor personal data and such.
Output table / New data table / Output table (after running macro)
To merge the both sheets I want to match id_date and id_hr in both files so if srcWorkbook and outWorkbook id's match, grab srcWorkbook row and paste it on the side of the outWorkbook.
I've tried to do a for / if statement which reads apparently but it doesn't paste the new rows. I also tried a VLOOKUP but I'd rather stick with basic statements for future modifications.
Sub popularSubG()
'File calling here and index variables
'Cells
' cell Src
Dim cellSrcPerPro As Long
Dim cellSrcIDHR As Long
' cell Out
Dim cellOutPerPro As Long
Dim cellOutIDHR As Long
For indexRowSrc = 2 To indexLastRowSrc
cellSrcPerPro = srcWorkbook.Cells(indexRowSrc, "A").Value
cellSrcIDHR = srcWorkbook.Cells(indexRowSrc, "B").Value
cellOutPerPro = outWorkbook.Cells(indexRowSrc, "A").Value
cellOutIDHR = outWorkbook.Cells(indexRowSrc, "B").Value
If cellSrcPerPro = cellOutPerPro & cellSrcIDHR = cellDestinoIDHR Then
indexRowOut = indexRowOut + 1
srcWorkbook.Sheets(1).Cells(2, "C").EntireRow.Copy Destination:=outWorkbook.Sheets(1).Range("O" & Rows.Count).End(xlUp).Offset(0)
End If
Next indexRowSrc
MsgBox "Sub ended"
End Sub
I am trying to search for specific terms and count the number of occurrences of that term within that column. I am using this macro by copying and pasting a macro button into my active sheet as the name of the worksheet I'll be applying this to will always be different/changing (each sheet is named for a month of the year so it will be changing every time I have a new month's worth of data). The length of the column is also variable with every given month.
This used to work without issue but recently I began getting a 1004 application defined or object defined error at the line that reads:
.Range("P7:R7").Formula = strFormulas
Are my formulas too long? Here's all of the code I am using for this section:
With ActiveSheet.Columns("P:T")
.ColumnWidth = 10
End With
Range("P6").Value = "DeptShortName"
Range("Q6").Value = "IfCAN"
Range("R6").Value = "Business Unit Name"
Range("S6").Value = "Business Unit"
Dim lastRow As Long
'Set formulas to appear in columns 1, 2, 3 after column O
Dim strFormulas(1 To 3) As Variant
'Set last row to fill for columns P-R based on variable length of column O
lastRow = Range("O" & Rows.Count).End(xlUp).Row
'Auto fill formulas defined below to columns 1,2, 3 after column O, so columns P, Q, R
With ActiveSheet
strFormulas(1) = "=IF(ISNUMBER(SEARCH(""CCS"",O7)),""CCS"",IF(ISNUMBER(SEARCH(""DSO"",O7)),""DSO"",IF(ISNUMBER(SEARCH(""ALC"",O7)),""ALC"",IF(ISNUMBER(SEARCH(""RCD"",O7)),""RCD"",IF(ISNUMBER(SEARCH(""CMNA"",O7)),""CMNA"",IF(ISNUMBER(SEARCH(""CRNA"",O7)),""CRNA"",IF(ISNUMBER(SEARCH(""CCSCAN"",O7)),""CCSCAN"",IF(ISNUMBER(SEARCH(""CARLYLE"",O7)),""CARLYLE"",IF(ISNUMBER(SEARCH(""CRS"",O7)),""CRS"",IF(ISNUMBER(SEARCH(""ICP"",O7)),""ICP"",IF(ISNUMBER(SEARCH(""MISCELLANEOUS"",O7)),""MISC"",IF(ISNUMBER(SEARCH(""NAO"",O7)),""NAO DIST"",IF(ISNUMBER(SEARCH(""NATIONAL"",O7)),""NATIONAL"",""""))))))))))))"
strFormulas(2) = "=IF(ISNUMBER(SEARCH(""CCSCAN"",O7)),""CAN"",IF(ISNUMBER(SEARCH(""ALC 0211"",O7)),""CAN"",IF(ISNUMBER(SEARCH(""ALC 0218"",O7)),""CAN"",IF(ISNUMBER(SEARCH(""ALC 0251"",O7)),""CAN"",""""))))"
strFormulas(3) = "=CONCATENATE(P7,Q7)"
.Range("P7:R7").Formula = strFormulas
.Range("P7:R" & lastRow).FillDown
End With
I have 2 different excel workbooks, one is called DATA and one is called ReportTemplate. So now i need to insert data from DATA to corresponding row/column in ReportTemplate.
How I am doing now is, for example:
'Others ( this is for other currencies)
DATA_FILE.activate
Sheets("SA_FX_2").select
SRC_SA_FX_2_D25 = Range("D25").Value
SRC_SA_FX_2_E25 = Range("E25").Value
SRC_SA_FX_2_F25 = Range("F25").Value
SRC_SA_FX_2_G25 = Range("G25").Value
SRC_SA_FX_2_H25 = Range("H25").Value
REPORTTEMPLATE_FILE.activate
Sheets("SA_FX_2").select
Range("D36").Value = SRC_SA_FX_2_D25
Range("E36").Value = SRC_SA_FX_2_E25
Range("F36").Value = SRC_SA_FX_2_F25
Range("G36").Value = SRC_SA_FX_2_G25
Range("H36").Value = SRC_SA_FX_2_H25
The SRC_SA_FX_2_X25 is to store the values for that particular cells in DATA, then insert it into Range("X36").Value in REPORTTEMPLATE. So currently I am doing the "mapping" in a hard-coded way.
This is how my DATA looks like:
DATA TEMPLATE
And this is how my REPORTTEMPLATE looks like:REPORTTEMPLATE
For the "Others" and above currencies, they are all fixed, so I can just hard code the cells.
However, if there is any new currency, my macro should detect that, then choose the currency in the drop down list, and do the mapping.
How can I actually parameterize my codes above in order to the mapping for the rest of the currencies?
Thank you for your advice.
A simple way would be to MATCH them like:
'we look for rows 3 to 5 of DATA_FILE in REPORTTEMPLATE_FILE
Dim i As Long, OutRow As Variant, wsIn As Worksheet, wsOut As Worksheet
Set wsIn = DATA_FILE.Sheets("SA_FX_2")
Set wsOut = REPORTTEMPLATE_FILE.Sheets("SA_FX_2")
For i = 3 To 5
'get the row of the active item in REPORTTEMPLATE_FILE
OutRow = Application.Match(wsIn.Cells(i, 3).Value2, wsOut.Columns(3), 0)
If Not IsNumeric(OutRow) Then OutRow = Application.Match("-- Please Select Currency --", wsOut.Columns(3), 0) 'not there -> new line
wsOut.Range("C" & OutRow & ":H" & OutRow).Value2 = wsIn.Range("C" & i & ":H" & i).Value2
Next
Just change the For i = 3 To 5 to fit your needs and check, if the "-- Please Select Currency --" does match.
If you have any questions or problems, just ask ;)
Good evening. I am desperate for some help with a short piece of VBA Code I am writing.
Public TFOCUS As Integer ' Creates TFOCUS, which is the worksheet in focus
Public RFOCUS As Integer ' Creates RFOCUS, which is the row in focus
Public CFOCUS As String ' Creates CFOCUS, which is the column in focus
Public RECORD As Integer ' Creates RECORD, wich is the row that is having the record written to
FILEPATH.Worksheets(TFOCUS).Range(Cells(RFOCUS, B)).Value = Worksheets(3).Range(Cells(RECORD, A)).Value 'copies focus EmpID to destination
FILEPATH.Worksheets(TFOCUS).Range(Cells(4, CFOCUS)).Value = Worksheets(3).Range(Cells(RECORD, B)).Value 'copies focus Course to destination
FILEPATH.Worksheets(TFOCUS).Range(Cells(RFOCUS, CFOCUS)).Value = Worksheets(3).Range(Cells(RECORD, C)).Value 'copies focus Date to destination
CFOCUS = CFOCUS + 1 'moves focus to next column
RECORD = RECORD + 1 'creates next record
FILEPATH is set to the path of an external Excel workbook. In this instance, TFOCUS is set to 1, RFOCUS is set to 5, CFOCUS is set to "Q", and RECORD is set to 1.
The purpose is to copy records from an external excel document into the active spreadsheet, and reformat them by moving the cell contents about. This will be used to move multiple sources, and will have to deal with every tab in every source document (which could all be named something different).
The issue I am having is that I am recieving a Runtime Error 13: Type Mismatch error when compiling, on the following line:
FILEPATH.Worksheets(TFOCUS).Range(Cells(RFOCUS, B)).Value = Worksheets(3).Range(Cells(RECORD, A)).Value 'copies focus EmpID to destination
I am assuming that this is either to do with the use of TFOCUS as an integer or FILEPATH as a file path. Can anyone suggest:
What exactly the mismatch is
If it is because of using Worksheets(TFOCUS), any way I can reference the worksheet by its number in the tab order using a variable?
Any other suggestions?
Thanks in advance for your help.
You're not showing us where/whether the variables are assigned, but...
Public RFOCUS As Integer ' Creates RFOCUS, which is the row in focus
Public CFOCUS As String ' Creates CFOCUS, which is the column in focus
Try declaring CFOCUS as an Integer. Or better, as a Long, so that your code works beyond row 32767 (the Integer type is 16-bit and signed, so 32768 is an overflowing value).
Also, if FILEPATH is a String, then your code can't work:
FILEPATH is set to the path of an external Excel workbook.
FILEPATH.Worksheets(TFOCUS)
It should be a Workbook object.. but then the identifier you're using is very confusing.
Dim wb As Workbook
Set wb = Workbooks.Open(FILEPATH)
wb.Worksheets(TFOCUS).Range(Cells(RFOCUS, B)).Value = Worksheets(3).Range(Cells(RECORD, A)).Value 'copies focus EmpID to destination
wb.Worksheets(TFOCUS).Range(Cells(4, CFOCUS)).Value = Worksheets(3).Range(Cells(RECORD, B)).Value 'copies focus Course to destination
wb.Worksheets(TFOCUS).Range(Cells(RFOCUS, CFOCUS)).Value = Worksheets(3).Range(Cells(RECORD, C)).Value 'copies focus Date to destination
CFOCUS = CFOCUS + 1 'moves focus to next column
RECORD = RECORD + 1 'creates next record
'save [wb] workbook? Close it?
Set wb = Nothing
May I also suggest to keep YELLCASE for constants, and to use camelCase for locals and PascalCase for everything else?
If RFOCUS is set to "Q" and B and A are integers, then this:
FILEPATH.Worksheets(TFOCUS).Range(Cells(RFOCUS, B)).Value = Worksheets(3).Range(Cells(RECORD, A)).Value
should be:
FILEPATH.Worksheets(TFOCUS).Range(RFOCUS & B).Value = Worksheets(3).Cells(Record, A).Value
Here are all 3 lines:
FILEPATH.Worksheets(TFOCUS).Range(RFOCUS & B).Value = Worksheets(3).Cells(Record, A).Value
FILEPATH.Worksheets(TFOCUS).Cells(4, CFOCUS).Value = Worksheets(3).Cells(Record, B).Value
FILEPATH.Worksheets(TFOCUS).Range(RFOCUS & CFOCUS).Value = Worksheets(3).Cells(Record, C).Value