I am trying to generate a simplistic Excel VBA function to calculate different types of interpolation. One difficulty I have is that, I don't seem to be able to re-assign the Y-range of values within the function.
When my VBA function reaches the following line, it doesn't seem to be able to change/re-calculate the YRange value according to the formula:
YRange(rowCount) = -Log(YRange(rowCount)) / XRange(rowCount)
Can anyone advise/help?
Public Function Kian_CurveInterp(XRange As Range, YRange As Range, XFrac As Double, InterpMode As Integer)
Select Case InterpMode
Case 1 'step-straight
Kian_CurveInterp = Linterp2(XRange, YRange, XFrac)
Case 2 'zero-rate interp
Dim rowCount As Integer
For rowCount = 1 To XRange.Count
YRange(rowCount) = -Log(YRange(rowCount)) / XRange(rowCount) 'convert discountFactors to zero-rates
Next rowCount
Kian_CurveInterp = Linterp2(XRange, YRange, XFrac)
Kian_CurveInterp = Exp(-Kian_CurveInterp * XFrac)
End Select
End Function
Related
I've been searching for a way to fill in column 'H' and 'I' of the attached image.
For 'H' I need to count every time the date and date shipped out don't equal for each item. It will be something like this:
(A:A <> D:D, B:B = $G$2, E:E <> "Base Inventory")
The second equation is to calculate the average lead time for each item:
Average(E:E - D:D) where B:B = $G$2, and D:D = "Complete" while ignoring rows with blanks
The table is much larger than the image and I can't use a helper row.
Thanks.
Example Sheet
For the first part, shipping calc, I wrote a function that will compute it for you:
Public Function Shippingcalc(item1 As Range, codes As Range, date2 As Range, shipped As Range, status As Range)
Dim Count As Integer
Count = 0
For n = 1 To codes.Rows.Count
If status.Cells(n, 1).Value <> "Base Inventory" Then
If codes.Cells(n, 1).Value = item1.Cells(1, 1).Value Then
If shipped.Cells(n, 1).Value <> 0 Then
If shipped.Cells(n, 1).Value <> date2.Cells(n, 1).Value Then
Count = Count + 1
End If
End If
End If
End If
Next n
Shippingcalc = Count
End Function
You have to implement that as a macro and macro-enable the workbook.
Then the function in H would look something like:
=Shippingcalc(G2, B$2:B$10, A$2:A$10, D$2:D$10, C$2:C$10)
And you can copy that (of course updating to the full column size).
Something similar should work for the other computation.
For some reason this morning while I was taking a poop, the equation for lead time came to me. It was way simpler than I imagined and goes back to high school math.
Average = (SUM(Received date) - SUM(Shipped date)) / Total
=(SUMIFS(E:E,B:B, G2,D:D,"<>",E:E,"<>") - SUMIFS(D:D,B:B, G2,D:D,"<>",E:E,"<>")) / (COUNTIFS(B:B, Q14, D:D,"<>",E:E,"<>")+1)
Thanks for your help guys.
I need to summarize unique values from a row into a column that's in the same row. My goal is in the second row of the attached image where T:Z contains the data and AA:AC contains the summary (I typed the values in for the demo). The first row is what is currently occurring where I tried using a nested if function for values greater than zero, but I also tried using an index match function to no avail. The issue is I either receive duplicates in AA:AC or not all values are included.
Currently using Excel 2016
So if I understand you correctly, you are going to have a sheet of rows of data. You want to look in the columns T:Z and then generate a list of unique values (non-zero) in the columns AA:AC. I assume that you know you will never have more than 3 unique values, but I can't be sure that this wasn't just an omission.
Either way, the below code should work:
Sub Find_Uniques()
Dim X As Integer, Y As Integer, Z As Integer
Dim Temp_Strings() As String
For X = 1 to 10000 'This assumes you don't have more than 10,000 rows of data
ReDim Temp_Strings(1 to 5) As String
For Y = 20 to 26
If Range(Cells(X,Y).Address).Value <> "" And Range(Cells(X,Y).Address).Value <> 0 Then
For Z = 1 to 5
If Temp_Strings(Z) = "" Then
Temp_Strings(Z) = Range(Cells(X,Y).Address).Value
Exit For
End If
If Temp_Strings(Z) = Range(Cells(X,Y).Address).Value Then Exit For
Next Z
End If
Next Y
For Z = 1 to 5
If Temp_Strings(Z) <> "" Then Range(Cells(X,Z+26).Address)).Value = Temp_String(Z)
Next Z
Next X
End Sub
Thank you all for your help. Instead of extracting the data from the row, I wrote a macro that changed the zeros to blanks, deleted the blank cells, and shifted them to the left. After that it was easy to cut the range and paste it into the old data set to be analyzed.
Sub clean_data()
Sheets("Reason data").Range("H:Z").Replace 0, ""
Call delete_blanks
End Sub
Sub delete_blanks()
Sheets("Reason data").Range("H:Z").SpecialCells(xlCellTypeBlanks).Delete (xlToLeft)
Call move_data
End Sub
Sub move_data()
'Copies reason data and pastes it into data worksheet
Sheets("Reason data").Range("A3:K3", Sheets("Reason data").Range("A3:F3").End(xlDown)).Cut _
Sheets("Data").Range("A1").End(xlDown).Offset(1)
End Sub
I'm making a IS task. I have a flatfile column named SCB_ActualMIN with a data type string [DT_STR]. I also have a script component to convert the SCB_ActualMIN column to numeric data type. I have this code in my script component
If Not Row.SCBActualDTime_IsNull AndAlso
Not String.IsNullOrEmpty(Row.SCBActualDTime.Trim) Then
Dim dtDate As Date
If DateTime.TryParse(Row.SCBActualDTime.Trim, dtDate) Then
Row.OutPutColumn = dtDate
Else
'If column cannot be parsed
Row.OutPutColumn_IsNull = True
End If
Else
Row.OutPutColumn_IsNull = True
End If
'''''SCBActualDTime
If Not Row.SCBActualMIN_IsNull AndAlso
Not String.IsNullOrEmpty(Row.SCBActualMIN.Trim) Then
Dim MIN As Integer
If Int32.TryParse(Row.SCBActualMIN.Trim, MIN) Then
Row.OutPut2Column = MIN
Else
'If column cannot be parsed
Row.OutPut2Column_IsNull = True
End If
Else
Row.OutPut2Column_IsNull = True
End If
As you can see the conversion of string to datetime data type is successful. While using the same code for string to integer. The Int32.TryParse(Row.SCBActualMIN.Trim, MIN) always return false even I have the value 09764377211 in the line code. Also is there other way for me to avoid the repetition of code.
9764377211 is bigger than 2147483647 which is the maximum value that can be assigned to Int32
Try converting value to Int64 or Double instead of Int32
Dim MIN As Int64
If Int64.TryParse(Row.SCBActualMIN.Trim, MIN) Then
Row.OutPut2Column = MIN
Else
'If column cannot be parsed
Row.OutPut2Column_IsNull = True
End If
OR
Dim MIN As Double
If Double.TryParse(Row.SCBActualMIN.Trim, MIN) Then
Row.OutPut2Column = MIN
Else
'If column cannot be parsed
Row.OutPut2Column_IsNull = True
End If
You cannot avoid repetition because you have to check each column for null by using it is own _IsNull property. You can try minimizing code by creating functions.
First of all, like #Yahfoufi suggested the exception is thrown because the value "9764377211 is bigger than 2147483647 which is the maximum value that can be assigned to Int32..."
You can Read more in this MSDN article about Data Types and corresponding Maximum values.
Type Storage size Range
Int32 4 bytes -2,147,483,648 to 2,147,483,647
Int64 8 bytes Approximately -9.2E+18 to 9.2E+18
Double 8 bytes Approximate range is -1.79E+308 to 1.79E+308 with accuracy of about 15 digits. Can represent numbers as small as 1E-323.
Decimal 12 bytes Approximate range is -7.9E+28 to 7.9E+28 with accuracy of 28 digits. Can represent numbers as small as 1E-28.
...
You can assign this value to Int64 or Decimal or Double Data Types
Optimizing your code
In this case you cannot avoid the repetition of these parts of code because there are using independent properties that cannot be called dynamically:
Checking if Input Columns is Null or Empty
If Not Row.SCBActualMIN_IsNull AndAlso
Not String.IsNullOrEmpty(Row.SCBActualMIN.Trim) Then
Assigning Null to the output column if value cannot be parsed or input is Null or Empty
Row.OutPut2Column_IsNull = True
You can modify your code to minimize number of lines but i don't think it will improve the performance
For each Data Type declare one variable inside the RowProcessing Sub and make your code as the following:
Assuming that these 2 columns are containing dates
Dim dtDate As Date
If Not Row.SCBActualDTime_IsNull AndAlso
Not String.IsNullOrEmpty(Row.SCBActualDTime.Trim) AndAlso
DateTime.TryParse(Row.SCBActualDTime.Trim, dtDate)Then
Row.OutPutColumn = dtDate
Else
'If column cannot be parsed or it is null
Row.OutPutColumn_IsNull = True
End If
'Assuming that SCBActualMIN is a Date
If Not Row.SCBActualMIN_IsNull AndAlso
Not String.IsNullOrEmpty(Row.SCBActualMIN.Trim) AndAlso
DateTime.TryParse(Row.SCBActualMIN.Trim, dtDate)Then
Row.OutPut2Column = dtDate
Else
'If column cannot be parsed
Row.OutPut2Column_IsNull = True
End If
Having a large amount of lines of code is not an issue if performance is good or optimal, Also minimizing the number of lines of code will not necessary improve the performance
Useful Links on SSIS , SQL , .Net Data Types
https://msdn.microsoft.com/en-us/library/cc716729(v=vs.110).aspx
http://www.sqlservergeeks.com/sql-server-and-ssis-data-types/
https://learn.microsoft.com/en-us/sql/integration-services/extending-packages-custom-objects/data-flow/working-with-data-types-in-the-data-flow#mapping-data-types-in-the-data-flow
https://learn.microsoft.com/en-us/sql/integration-services/data-flow/integration-services-data-types
My model takes two numbers from one sheet, adds the average to another sheet in the last cell of a defined column. The problem that I have is that when I insert a new column, the references get missed up and I'm trying to have a macro that would 1. take the average 2. look for a specific column on the second sheet 3. paste the averaged value to the last cell.
Please help me with this I have been trying to get my head around it for a long time.
my problem is that I have to insert new columns and I need to keep the references dynamic when adding a value to the last empty cell in a column. For example: if i have salary as col A, and expenses as Col B - in this model that I have now I put in .Cells(emptyRow, 1) and .Cells(emptyRow, 2) now if I insert a column between A and B the references 1 and 2 will not work. Is there anyway that I can work around this where if i add a new column it wont mess up the references in the macro?
Thank you.
This is the code that I have right now but it does not really work - when I insert a new column the column defined name does not shift right.
Sub demo()
Dim expCol As Long, FirstEmptyRow As Long
Range("B:B").Cells.Name = "expenses"
expCol = Range("expenses").Column
FirstEmptyRow = Cells(Rows.Count, expCol).End(xlUp).Row + 1
Cells(FirstEmptyRow, expCol).Value = 123
End Sub
P.S. 123 here is just an example for testing purposes. The value that would replace it in my model is the average I talk about in the question.
If your columns have headers (I guess they do), and your data has no gaps just use
Range("1:1").Find(columnName).End(xlDown).Offset(1,0) = 123
If a column can have just a header but no values, you need to add additional check if second row isn't empty.
If you create a named range this way (rather than the Range.Cells.Name way you were using), then when inserting columns the reference will be dynamic. Now if you insert columns between A and B later in the code, you can still use expCol and FirstEmptyRow to reference the first empty cell in the expenses column, where ever it may have moved to on the sheet, as long as you update them after each column insertion.
Sub Demo()
Dim expensesrng As Range
Dim Expenses As Range
Dim expCol As Long
Dim Exprng As Range
Dim FirstEmptyRow As Long
'set the original range to use for the expense column
Set expensesrng = Range(Range("B1"), Range("B1").End(xlDown))
'add the named range
ActiveWorkbook.Names.Add Name:="Expenses", RefersTo:=expensesrng
' create a variable to refer to the Expenses Range
Set Exprng = ActiveWorkbook.Names("Expenses").RefersToRange
expCol = ActiveWorkbook.Names("Expenses").RefersToRange.Column
FirstEmptyRow = Exprng.End(xlDown).Offset(1, 0).Row
Cells(FirstEmptyRow, expCol).Value = 123
'after inserting columns then you will have to get/update the column number
'of the expense named range and the first empty row before adding your new expense
'data to it
Range("B:B").Insert Shift:=xlShiftToRight
expCol = ActiveWorkbook.Names("Expenses").RefersToRange.Column
FirstEmptyRow = expensesrng.End(xlDown).Offset(1, 0).Row
Cells(FirstEmptyRow, expCol).Value = 123
End Sub
I'm working with a script designed to compare values returned from a form against values from a database dumped to an array, via GetRows. The purpose of the check is to compare form values against database values and only update the matching ids' rows in the database.
I've seen this done with hidden variables in forms, but as we have quite a few users online at any given time, the values on the db end could change while a user was completing the form.
Currently, the code uses an inner and outer loop to run this comparison, with a temporary variable being assigned the current col/row from the aforementioned array. An lcase and trim operation are performed on the value to obtain the temporary variable.
This is causing a considerable performance drain, and I was wondering if the lcase/trim functionality could perhaps be performed during the creation of that array, rather than in a looping situation?
Here's my code:
**note: this utilizes the FastString Class for concatenation, thus the "FastString" and ".Append"
dim iRowLoop, iColLoop, zRowLoop, strChange, tempDbValsCase
Set strChange = New FastString
for iRowLoop = 0 to ubound(arrDbVals, 2)
for zRowLoop = 0 to ubound(arrFormComplete)
''#****below line is what is causing the bottleneck, according
''#****to a timer test
tempDbValsCase = lcase(trim(arrDbVals(1, iRowLoop)))
''#****
if (mid(trim(arrFormComplete(zRowLoop)),1,8) = trim(arrDbVals(0, iRowLoop))) AND (mid(trim(arrFormComplete(zRowLoop)),9) <> tempDbValsCase) then
dim strFormAllVals
strFormAllVals = arrFormComplete(zRowLoop)
strChange.Append strFormAllVals & ","
end if
next
next
On the database side (MS SQL Server 2008), the table from which the array is derived through GetRows contains the bit datatype column "Complete". The lcase and trim operations are performed upon this column of the array. Does the bit datatype add any hidden characters in the output? Visually, I don't detect any, but when I compare a value of "True" from the form input against a value from the array that looks like "True," it doesn't match, until I run the lcase and trim on the "Complete" column.
Try
dim iRowLoop, iColLoop, zRowLoop, strChange, tempDbValsCase
dim iCount1, iCount2, match
Set strChange = New FastString
iCount1 = ubound(arrDbVals, 2)
iCount2 = ubound(arrFormComplete)
for iRowLoop = 0 to iCount1
for zRowLoop = 0 to iCount2
' Assign array lookup to a variable '
tempDbValsCase = arrDbVals(1, iRowLoop)
' ...and then perform operations on it one at a time '
tempDbValsCase = trim(tempDbValsCase)
tempDbValsCase = lcase(tempDbValsCase)
' Assign this array lookup to a variable and perform trim on it '
match = trim(arrFormComplete(zRowLoop))
if (mid(match,1,8) = trim(arrDbVals(0, iRowLoop))) AND (mid(match,9) <> tempDbValsCase) then
strChange.Append match & ","
end if
next
next