I did use the case statement to create a character field with the correct numbering separator from a numeric field based on the currency symbol, I think I only need to evaluate two cases if it is "€" using space as separator and anything else just use the comma ","
I'm having a problem to simplify the case function formula below, right now I evaluating "€", "$", and "£" and I think it is unnecessary.
Thanks in advance!
CASE(Currency_Symbol__c, "€", IF(
Room_Size__c >= 1000000,
TEXT(FLOOR(Room_Size__c / 1000000)) & " ",
"") &
IF(
Room_Size__c >= 1000,
RIGHT(TEXT(FLOOR(Room_Size__c / 1000)), 3) & " ",
"") &
RIGHT(TEXT(FLOOR(Room_Size__c)), 3), "$",
IF(
Room_Size__c >= 1000000,
TEXT(FLOOR(Room_Size__c / 1000000)) & ",",
"") &
IF(
Room_Size__c >= 1000,
RIGHT(TEXT(FLOOR(Room_Size__c / 1000)), 3) & ",",
"") &
RIGHT(TEXT(FLOOR(Room_Size__c)), 3), "£",
IF(
Room_Size__c >= 1000000,
TEXT(FLOOR(Room_Size__c / 1000000)) & ",",
"") &
IF(
Room_Size__c >= 1000,
RIGHT(TEXT(FLOOR(Room_Size__c / 1000)), 3) & ",",
"") &
RIGHT(TEXT(FLOOR(Room_Size__c)), 3),"0")
You're getting lost in too many ()?
I'd start by formatting it bit better:
CASE(Currency_Symbol__c,
"€", IF(Room_Size__c >= 1000000, TEXT(FLOOR(Room_Size__c / 1000000)) & " ", "")
& IF(Room_Size__c >= 1000, RIGHT(TEXT(FLOOR(Room_Size__c / 1000)), 3) & " ","")
& RIGHT(TEXT(FLOOR(Room_Size__c)), 3),
...
)
So to have just € and default:
CASE(Currency_Symbol__c,
"€", IF(Room_Size__c >= 1000000, TEXT(FLOOR(Room_Size__c / 1000000)) & " ", "")
& IF(Room_Size__c >= 1000, RIGHT(TEXT(FLOOR(Room_Size__c / 1000)), 3) & " ","")
& RIGHT(TEXT(FLOOR(Room_Size__c)), 3),
IF(Room_Size__c >= 1000000, TEXT(FLOOR(Room_Size__c / 1000000)) & ",", "")
& IF(Room_Size__c >= 1000, RIGHT(TEXT(FLOOR(Room_Size__c / 1000)), 3) & ",","")
& RIGHT(TEXT(FLOOR(Room_Size__c)), 3),
)
Or... now you have a CASE with just 2 branches - maybe this would look cleaner?
IF(Room_Size__c >= 1000000,
TEXT(FLOOR(Room_Size__c / 1000000)) + IF(Currency_Symbol__c = '€', ' ', ','),
''
) +
IF(Room_Size__c >= 1000,
TEXT(FLOOR(Room_Size__c / 1000)) + IF(Currency_Symbol__c = '€', ' ', ','),
''
) +
RIGHT(TEXT(FLOOR(Room_Size__c)), 3)
Related
I have long searched for a way to match 2 arrays based on several conditions and then write a value to that array after those conditions are met. I HAVE done so, BUT it is far to slow and crashes Excel. I am trying to use the dictionary object to achieve this in an effort to speed up my matching procedure but I am failing miserably.
Simply put, in the below procedure, I am checking if certain conditions are true. If so then then write to OutPut_Array so that I can match the value found in the ShtInPut_Array later.
Sub Cat_Payments_Test2()
Dim InPut_Array As Variant, ShtInPut_Array As Variant
Dim OutPut_Array()
Dim i As Long
Dim x As Long, y As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Would have used Value 2, but I want to preseve the Date formating
InPut_Array = Sheet19.Range("A1:NWH26").Value
ShtInPut_Array = Sheet14.Range("A2:Z50667").Value
ReDim OutPut_Array(1 To 3, LBound(InPut_Array, 2) To UBound(InPut_Array, 2))
'The Part is super fast
'On Error Resume Next
For i = LBound(InPut_Array, 2) To UBound(InPut_Array, 2)
'Case 1: InPut_Array(14, i) is on the first day of the month
If InPut_Array(15, i) = (InPut_Array(15, i) - Day(InPut_Array(15, i)) + 1) Then
'Looking for payments On First Day of CurrMonth
If Len(InPut_Array(21, i)) = 7 And IsNumeric(InPut_Array(21, i)) _
And InPut_Array(20, i) > 0 And (InPut_Array(16, i) = InPut_Array(17, i) Or InStr(InPut_Array(16, i), "Reclas") _
Or InStr(InPut_Array(16, i), "*Req Adj*")) And Not (InStr(InPut_Array(16, i), "Prior")) Then
InPut_Array(25, i) = "Payment"
InPut_Array(26, i) = "Repair Order"
ElseIf Len(InPut_Array(20, i)) = 7 And IsNumeric(InPut_Array(20, i)) And (InStr(InPut_Array(15, i), "Prior") _
Or InStr(InPut_Array(15, i), "Current")) And InPut_Array(19, i) < 0 Then
InPut_Array(24, i) = "RO/Accr Adj."
InPut_Array(25, i) = "Reversing Entry"
End If
'Case 2 : InPut_Array(14, i) is between the first day of the month and the last day of the month
ElseIf (InPut_Array(15, i) - Day(InPut_Array(15, i)) + 1) < InPut_Array(14, i) < WorksheetFunction.EoMonth(InPut_Array(15, i), 0) Then
'Looking for payments MidMonth (i.e. after the FirstDay_CurrMon _
but before LastDayCurrMont
If Len(InPut_Array(21, i)) = 7 And IsNumeric(InPut_Array(21, i)) And InPut_Array(20, i) > 0 And (InPut_Array(16, i) = InPut_Array(17, i) _
Or InStr(InPut_Array(16, i), "Reclas") Or InStr(InPut_Array(16, i), "*Req Adj*")) And Not (InStr(InPut_Array(16, i), "Prior")) Then
InPut_Array(25, i) = "Payment"
InPut_Array(26, i) = "Repair Order"
'Write PO Num
OutPut_Array(1, i) = InPut_Array(21, i)
'Print the first day of the current month's date
OutPut_Array(2, i) = DatePart("d", (CDate(InPut_Array(15, i)) - Day(CDate(InPut_Array(15, i))) + 1))
'Print the Amount
OutPut_Array(3, i) = Abs(InPut_Array(20, i))
End If
'Case 3.1 and 3.2
ElseIf InPut_Array(15, i) = WorksheetFunction.EoMonth(InPut_Array(15, i), 0) Then
If Len(InPut_Array(21, i)) = 7 And IsNumeric(InPut_Array(21, i)) _
And (InStr(InPut_Array(16, i), "Prior") Or InStr(InPut_Array(16, i), "Current")) _
And InPut_Array(20, i) < 0 Then
InPut_Array(25, i) = "RO/Accr Adj."
InPut_Array(26, i) = "Repair Order"
'Write PO Num
OutPut_Array(1, i) = InPut_Array(21, i)
'Print the first day of the current month's date
OutPut_Array(2, i) = DatePart("d", (InPut_Array(15, i) - Day(InPut_Array(15, i)) + 1))
'Print Amount
OutPut_Array(3, i) = Abs(InPut_Array(20, i))
'If criteria met for payment on the last day of the Current Month _
then do the same as payments for MidMonth
ElseIf Len(InPut_Array(21, i)) = 7 And IsNumeric(InPut_Array(21, i)) And InPut_Array(20, i) > 0 And (InPut_Array(16, i) = InPut_Array(17, i) _
Or InStr(InPut_Array(16, i), "Reclas") Or InStr(InPut_Array(16, i), "*Req Adj*")) _
And Not (InStr(InPut_Array(16, i), "Prior")) Then
InPut_Array(25, i) = "Payment"
InPut_Array(26, i) = "Repair Order"
'PO Num
OutPut_Array(1, i) = InPut_Array(21, i)
'Print the first day of the current month's date
OutPut_Array(2, i) = DatePart("d", (InPut_Array(15, i) - Day(InPut_Array(15, i)) + 1))
'Print Amount
OutPut_Array(3, i) = Abs(InPut_Array(20, i))
End If
End If
Next i
'This matching procedure is what is crashing excel
For x = LBound(ShtInPut_Array, 1) To UBound(ShtInPut_Array, 1)
For y = LBound(OutPut_Array, 2) To UBound(OutPut_Array, 2)
If ShtInPut_Array(x, 21) = OutPut_Array(1, y) _
And DatePart("d", ShtInPut_Array(x, 15)) = OutPut_Array(2, y) _
And Abs(ShtInPut_Array(x, 20)) = OutPut_Array(3, y) Then
ShtInPut_Array(x, 25) = "RO/Accr Adj."
ShtInPut_Array(x, 26) = "Repair Order"
Exit For
End If
Next y
Next x
Sheet17.Range("A2").Resize(UBound(ShtInPut_Array, 1), UBound(ShtInPut_Array, 2)) = ShtInPut_Array
Application.EnableEvents = True
End Sub
I have been trying to figure this out for a good week or more, and if I told you how many test modules that I have now from skimming SO and literally everywhere else, you would think I am insane. My thoughts where to adapt #TimWilliams idea from This post, but I would need array indexes, not addresses. At this point I need some SO genius. Thanks to all those with ideas, or answers!
Edit: Below is the full working code with #TimWilliams Dictionary Implementation (many many thanks Tim). The only difference is, I choose to use early binding instead of late binding for the Dictionary Object. To do this, you must reference Microsoft Scripting Runtime in the Visual Basic Editor (VBE) by selecting Tools > References > Microsoft Scripting Runtime. Early binding adds a bit more speed because you are informing Excel about the object ahead of runtime. It also enables the VBE's intellisense feature, which is nice for quickly accessing the properties and methods of an object.
Sub Cat_Payments_Test2()
Dim InPut_Array As Variant, ShtInPut_Array As Variant
Dim OutPut_Array()
Dim i As Long
Dim x As Long, y As Long
Dim Dict As Dictionary 'Early Binding
Dim k As Variant
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Would have used Value 2, but I want to preseve the Date formating
InPut_Array = Sheet19.Range("A1:NWH26").Value
ShtInPut_Array = Sheet14.Range("A2:Z50667").Value
ReDim OutPut_Array(1 To 3, LBound(InPut_Array, 2) To UBound(InPut_Array, 2))
For i = LBound(InPut_Array, 2) To UBound(InPut_Array, 2)
'Case 1: GL/Date (i.e.InPut_Array(14, i)) is on the first day of the month
If InPut_Array(15, i) = (InPut_Array(15, i) - Day(InPut_Array(15, i)) + 1) Then
'Looking for payments On First Day of CurrMonth
If Len(InPut_Array(21, i)) = 7 And IsNumeric(InPut_Array(21, i)) _
And InPut_Array(20, i) > 0 And (InPut_Array(16, i) = InPut_Array(17, i) Or _
InStr(InPut_Array(16, i), "Reclas") Or InStr(InPut_Array(16, i), "*Req Adj*")) _
And Not (InStr(InPut_Array(16, i), "Prior")) Then
InPut_Array(25, i) = "Payment"
InPut_Array(26, i) = "Repair Order"
ElseIf Len(InPut_Array(20, i)) = 7 And IsNumeric(InPut_Array(20, i)) _
And (InStr(InPut_Array(15, i), "Prior") Or InStr(InPut_Array(15, i), "Current")) _
And InPut_Array(19, i) < 0 Then
InPut_Array(24, i) = "RO/Accr Adj."
InPut_Array(25, i) = "Reversing Entry"
End If
'Case 2 : GL/Date is between the first day of the month and the last day of the month
ElseIf (InPut_Array(15, i) - Day(InPut_Array(15, i)) + 1) < InPut_Array(15, i) < WorksheetFunction.EoMonth(InPut_Array(15, i), 0) Then
'Looking for payments MidMonth (i.e. after the FirstDay_CurrMon _
but before LastDayCurrMont
If Len(InPut_Array(21, i)) = 7 And IsNumeric(InPut_Array(21, i)) And InPut_Array(20, i) > 0 _
And (InPut_Array(16, i) = InPut_Array(17, i) Or InStr(InPut_Array(16, i), "Reclas") Or InStr(InPut_Array(16, i), "*Req Adj*")) _
And Not (InStr(InPut_Array(16, i), "Prior")) Then
InPut_Array(25, i) = "Payment"
InPut_Array(26, i) = "Repair Order"
'Write PO Num
OutPut_Array(1, i) = InPut_Array(21, i)
'Print the first day of the current month's date
OutPut_Array(2, i) = DatePart("d", (InPut_Array(15, i) - Day(InPut_Array(15, i)) + 1))
'Print the Amount
OutPut_Array(3, i) = Abs(InPut_Array(20, i))
End If
'Case 3.1 and 3.2: If GL/Date is on the last of the month
ElseIf InPut_Array(15, i) = WorksheetFunction.EoMonth(InPut_Array(15, i), 0) Then
If Len(InPut_Array(21, i)) = 7 And IsNumeric(InPut_Array(21, i)) _
And (InStr(InPut_Array(16, i), "Prior") Or InStr(InPut_Array(16, i), "Current")) _
And InPut_Array(20, i) < 0 Then
InPut_Array(25, i) = "RO/Accr Adj."
InPut_Array(26, i) = "Repair Order"
'Write PO Num
OutPut_Array(1, i) = InPut_Array(21, i)
'Print the first day of the current month's date
OutPut_Array(2, i) = DatePart("d", (InPut_Array(15, i) - Day(InPut_Array(15, i)) + 1))
'Print Amount
OutPut_Array(3, i) = Abs(InPut_Array(20, i))
'If criteria met for payment on the last day of the Current Month _
then do the same as payments for MidMonth
ElseIf Len(InPut_Array(21, i)) = 7 And IsNumeric(InPut_Array(21, i)) And InPut_Array(20, i) > 0 _
And (InPut_Array(16, i) = InPut_Array(17, i) Or InStr(InPut_Array(16, i), "Reclas") Or InStr(InPut_Array(16, i), "*Req Adj*")) _
And Not (InStr(InPut_Array(16, i), "Prior")) Then
InPut_Array(25, i) = "Payment"
InPut_Array(26, i) = "Repair Order"
'PO Num
OutPut_Array(1, i) = InPut_Array(21, i)
'Print the first day of the current month's date
OutPut_Array(2, i) = DatePart("d", (InPut_Array(15, i) - Day(InPut_Array(15, i)) + 1))
'Print Amount
OutPut_Array(3, i) = Abs(InPut_Array(20, i))
End If
End If
Next i
'***************************
'Dictionary Implementation
Set Dict = New Dictionary 'Early Binding
'populate dictionary with composite keys from output array
For y = LBound(OutPut_Array, 2) To UBound(OutPut_Array, 2)
k = Join(Array(OutPut_Array(1, y), _
OutPut_Array(2, y), _
OutPut_Array(3, y)), "~~")
Dict(k) = True
Next y
'compare...
For x = LBound(ShtInPut_Array, 1) To UBound(ShtInPut_Array, 1)
k = Join(Array(ShtInPut_Array(x, 21), _
DatePart("d", ShtInPut_Array(x, 15)), _
Abs(ShtInPut_Array(x, 20))), "~~")
If Dict.Exists(k) Then
ShtInPut_Array(x, 25) = "RO/Accr Adj."
ShtInPut_Array(x, 26) = "Repair Order"
End If
Next x
'***************************
Sheet17.Range("A2").Resize(UBound(ShtInPut_Array, 1), UBound(ShtInPut_Array, 2)) = ShtInPut_Array
'Note for those who were curious as _
to why I did't Set Application.ScreenUpdating = True _
It's b/c Excel does so automatically, so not doing so _
pro-grammatically saves a bit of speed
Application.EnableEvents = True
End Sub
Something like this:
Dim dict, k
Set dict = CreateObject("scripting.dictionary")
'populate dictionary with composite keys from output array
For y = LBound(OutPut_Array, 2) To UBound(OutPut_Array, 2)
k = Join(Array(OutPut_Array(1, y), _
OutPut_Array(2, y), _
OutPut_Array(3, y)), "~~")
dict(k) = True
Next y
'compare...
For x = LBound(ShtInPut_Array, 1) To UBound(ShtInPut_Array, 1)
k = Join(Array(ShtInPut_Array(x, 21), _
DatePart("d", ShtInPut_Array(x, 15)), _
Abs(ShtInPut_Array(x, 20))), "~~")
If dict.exists(k) Then
ShtInPut_Array(x, 25) = "RO/Accr Adj."
ShtInPut_Array(x, 26) = "Repair Order"
End If
Next x
You have a wonderful reason to switch to an object-oriented approach - it's time to manage the complexity of the code by creating chains of responsibility, simplification, and splitting into short independent functions.
Object decomposition of the task may look like this:
Public Sub Code_All_2_Units_Tests (Optional ByVal msg As Variant)
Var_Public_Clear _
to_ClipBoard (_
Array_walk (_
Array_Comments_delete (_
Split_by_vbrclf (_
in_Quotes_remove (_
Underscore_replace (_
Paste_from_clipboard (_
Settings)))))))
End sub
Do not immediately strive for the speed of the code and its quality. First the quality of the code, then the speed.
The object-oriented approach has many other advantages.
A long loop
for(int a = 1,b = 10, c = 11, d = 20, e = 21, f = 30, a <= 10, a++, b--, c++, d--, e++, f--)
System.out.println(a + " " + b + " " + c + " " + d + " " + e + " " + f);
Update your code as below and you will have your expected table.
for(int a=1,b=10, c=11, d=20, e=21,f=30; a<=10;a++,b--,c++,d--,e++,f--)
System.out.println(a+ " " +b+ " " +c+ " "+d+ " "+e+ " "+f);
}
That is after the declarations you should have a ; not a , . And then, again after the condition also you should have a ; not a ,
I have a working .vbs file which reads a binary file, changes one byte and the saves the file. Up until Windows 1607 this worked fine on many different Windows systems.
However, now with 1607 and later versions of Windows 10 it no longer works!
I have changed the code because the read file code I had no longer works correctly in 1607, but I am still having problems with the
data = Mid(data, 1, 21) & Chr(b21) & Mid(data, 23) line which worked perfectly before Windows 10 1607!
I get
(60, 3) ADODB.Stream: Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another.
This code creates a shortcut on the Desktop and then changes one bit of one byte so that the shortcut will be run as admin. If I comment out the offending line then it seems to work.
Is this a bug in Windows 10 1607 VBScript?
' Make shortcut on Desktop and Set as Run As Admin
Q = Chr(34)
Dim fso
Dim curDir
Dim WinScriptHost
If WScript.Arguments.Count < 2 Then
WScript.Echo "Please run CreateShortcuts.cmd"
WScript.Quit
End If
' --- SET Target and Desktop Link Name from command line ---
strTargetName = WScript.Arguments.Item(0)
strLinkName = WScript.Arguments.Item(1)
'Target - e.g. %windir%\system32\cmd.exe /c C:\"temp\MakePartImage_AutoRun_FAT32.cmd"
Set WshShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
strWinDir =WshShell.ExpandEnvironmentStrings("%windir%")
strSysDir = strWinDir & "\System32"
strMyDir = fso.GetParentFolderName(wscript.ScriptFullName)
strDesktop = WshShell.SpecialFolders("Desktop")
strCurDir = WshShell.CurrentDirectory ' e.g. C:\temp
strMyDirSpecial = Mid(strMyDir, 1, 3) & Q & Mid(strMyDir, 4) & "\" & strTargetName & Q
Set oMyShortCut= WshShell.CreateShortcut(strDesktop + "\" & strLinkName)
oMyShortCut.WindowStyle = 1 '1=default 3=max 7=Min
oMyShortCut.TargetPath = Q & strSysDir & "\cmd.exe" & Q
oMyShortCut.Arguments= " /c " & strMyDirSpecial
oMyShortcut.IconLocation = "%windir%\system32\cmd.exe"
oMyShortCut.WorkingDirectory = Q & strMyDir & Q
oMyShortCut.Save
Set fso = Nothing
'read binary geometry into byte array
Dim stream, data
Set stream = CreateObject("ADODB.Stream")
stream.Open
stream.Type = 1
stream.LoadFromFile(strDesktop + "\" & strLinkName)
data = stream.Read
stream.Close
WScript.Echo "BYTES 16-23 " & Hex(Asc(Mid(data, 16, 1))) & " " & Hex(Asc(Mid(data, 17, 1))) & " " & Hex(Asc(Mid(data, 18, 1))) & " " & Hex(Asc(Mid(data, 19, 1))) & " " & Hex(Asc(Mid(data, 20, 1))) & " " & Hex(Asc(Mid(data, 21, 1))) & " " & Hex(Asc(Mid(data, 22, 1))) & " " & Hex(Asc(Mid(data, 23, 1)))
' --- PATCH .LNK FILE to set byte 21 bit 5 for Admin rights
Dim b21
b21 = Asc(Nid(data, 22, 1)) Or 32 'set bit 6 0x20
' THIS NEXT LINE CAUSES PROBLEMS!
data = Mid(data, 1, 21) & Chr(b21) & Mid(data, 23)
WScript.Echo "BYTES 16-23 " & Hex(Asc(Mid(data, 16, 1))) & " " & Hex(Asc(Mid(data, 17, 1))) & " " & Hex(Asc(Mid(data, 18, 1))) & " " & Hex(Asc(Mid(data, 19, 1))) & " " & Hex(Asc(Mid(data, 20, 1))) & " " & Hex(Asc(Mid(data, 21, 1))) & " " & Hex(Asc(Mid(data, 22, 1))) & " " & Hex(Asc(Mid(data, 23, 1)))
Const adTypeBinary = 1
Const adTypeText = 2
Const adSaveCreateOverWrite = 2
Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Type = adTypeBinary
BinaryStream.Open
BinaryStream.Write data
BinaryStream.SaveToFile strDesktop+"\" & strLinkName, adSaveCreateOverWrite
WScript.Echo "Shortcut " & strLinkName & " created on Desktop."
' THIS NEXT LINE CAUSES PROBLEMS!
data = Mid(data, 1, 21) & Chr(b21) & Mid(data, 23)
This line causes problems because it changes the type of data from Byte() to String. This would illustrate it:
WScript.Echo TypeName(data)
' THIS NEXT LINE CAUSES PROBLEMS!
data = Mid(data, 1, 21) & Chr(b21) & Mid(data, 23)
WScript.Echo TypeName(data)
ADODB Stream.Write function only accepts Byte() arrays.
The solution is to use this function from motobit website:
' http://www.motobit.com/tips/detpg_binarytostring/
Function MultiByteToBinary(MultiByte)
'� 2000 Antonin Foller, http://www.motobit.com
' MultiByteToBinary converts multibyte string To real binary data (VT_UI1 | VT_ARRAY)
' Using recordset
Dim RS, LMultiByte, Binary
Const adLongVarBinary = 205
Set RS = CreateObject("ADODB.Recordset")
LMultiByte = LenB(MultiByte)
If LMultiByte>0 Then
RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
RS.Open
RS.AddNew
RS("mBinary").AppendChunk MultiByte & ChrB(0)
RS.Update
Binary = RS("mBinary").GetChunk(LMultiByte)
End If
MultiByteToBinary = Binary
End Function
But the string needs to be converted to multi-byte first. For this purpose there is another function:
' http://www.motobit.com/help/regedit/pa26.htm
'Converts unicode string to a multibyte string
Function StringToMB(S)
Dim I, B
For I = 1 To Len(S)
B = B & ChrB(Asc(Mid(S, I, 1)))
Next
StringToMB = B
End Function
So, this is how to make it work:
data = Mid(data, 1, 21) & Chr(b21) & Mid(data, 23)
data = MultiByteToBinary(StringToMB(data))
I am using ado shape command on my data report, it works fine but when my aggregate function CALC(agrProfit/agrExtended*100) is null or 0/0*100 it shows general error and data report not showing up. Please Help.
mRS.Open "SHAPE {select products.productid,products.productcode,isnull(products.description,descr) as description,isnull(vendor.description,'*** NOT FOUND ***') as groupdescription, " & _
"isnull(sum(totalcost),0) as mTotalCost,isnull(sum(extended) - (sum(totalcost)),0) as mProfit, " & _
"sum(charges) as mCharges,sum(discount) as mDiscounts, sum(retextended) as mReturns, " & _
"reportuom, sum(totalcost) as mTotalCost, isnull(case when sum(extended) = 0 then 0 else (sum(extended) - (sum(totalcost)))/sum(extended)*100 end,0) as mgpm, sum(totalcost) as mTotalCost, case when sum(extended) = 0 then 0 else (sum(extended) - (sum(totalcost)))/sum(extended)*100 end as mgpm, sum(case when extended < 0 then (0 - (totalqty/products.reportqty)) else (totalqty/products.reportqty) end) as mTotalQty, isnull(sum(extended),0) as mExtended, sum(case when extended < 0 then (0 - (totalqty/products.reportqty)) else (totalqty/products.reportqty) end) / " & mTotalQty & " * 100 as mPercTotalQty, sum(extended) / " & mTotalExtended & " * 100 as mPercExtended " & _
"From " & _
"(select finishedsales.QtyReturned,finishedsales.productid,finishedsales.description as descr, finishedsales.averageunitcost* case when [return]=1 then convert(money,0-totalqty) else totalqty end as TotalCost,(chargeallowance * qty) + (chargeamountdiscounted * qty) as charges,(allowance * qty) + (amountdiscounted * qty)+ (extended-(extended * multiplier)) as discount,0 as rettotalqty, 0 as retextended,totalqty,round(extended * multiplier,4) as extended From finishedsales " & _
" left join products on products.productid = finishedsales.productid " & _
.gReportCriteria & _
"Union All " & _
"select finishedsales.QtyReturned, finishedsales.productid,finishedsales.description as descr,0 as totalcost,0 as charges,0 as discount,totalqty as rettotalqty ,abs(round(extended,4)) as retextended,0 as totalqty, 0 as extended From finishedsales " & _
"left join products on products.productid = finishedsales.productid " & _
Replace(UCase(.gReportCriteria & " and [RETURN] = 1"), "[RETURN] = 0", "[return] = 1") & _
") as finishedsales " & _
"left join products on products.productid=finishedsales.productid " & _
"left join vendor on products.vendorcode=vendor.vendorcode " & _
"group by descr,products.productid,products.productcode,products.description,vendor.description,reportuom " & _
"order by groupdescription, " & IIf(frmReportProducts.chkTop And fVal(frmReportProducts.txtTop) > 0, "finishedsales.mtotalqty desc,", "") & " products.description} AS Command1 COMPUTE Command1, SUM(Command1.mTotalQty) AS agrTotalQty, SUM(Command1.mExtended) AS agrExtended, SUM(Command1.mProfit) AS agrProfit, CALC(agrProfit/agrExtended*100) As agrGPM BY groupdescription", mcn
So it looks like you're using the ADO Data Shaping functions here, and the CALC(expression) allows you to use VBA functions listed here within the expression. #C-Pound Guru's suggestion causes an error since NULLIF() is not a VBA function, but the whole expression can be rewritten like this:
CALC(IIF(IsNull(agrProfit), 0, IIF(agrProfit=0, 0, agrProfit/agrExtended) *100))
Let me know if this takes care of your issue.
If your SQL Server is 2005 or newer you can use NULLIF in conjunction with ISNULL:
Replace agrProfit/agrExtended with
ISNULL(agrProfit / NULLIF(agrExtended,0),0)
This will return zero when agrExtended=0 rather than causing a divide by zero error.
It seems that you're using MS Access or something that interfaces with MS Access. If that is the case, maybe you can use Switch:
Replace:
CALC(agrProfit / agrExtended * 100)
With:
Switch(
ISNULL(SUM(Command1.mExtended)), 0,
ISNULL(SUM(Command1.mProfit)), 0,
IIF(SUM(Command1.mExtended) = 0, 0, SUM(Command1.mProfit) / SUM(Command1.mExtended) * 100)
)
The idea is to replace NULL with 0, replace Divide by 0 with 0, or else return the actual ratio.
I'm having issues reading a CSV file to then add containing numbers together.
main.au3
$billsRawData1 = FileReadLine(#AppDataDir & "\testDir\test.csv", 2)
$billsArray1 = StringSplit($billsRawData1, ",")
$billsRawData2 = FileReadLine(#AppDataDir & "\testDir\test.csv", 3)
$billsArray2 = StringSplit($billsRawData2, ",")
$billsRawData3 = FileReadLine(#AppDataDir & "\testDir\test.csv", 4)
$billsArray3 = StringSplit($billsRawData3, ",")
$billsRawData4 = FileReadLine(#AppDataDir & "\testDir\test.csv", 5)
$billsArray4 = StringSplit($billsRawData4, ",")
$billsRawData5 = FileReadLine(#AppDataDir & "\testDir\test.csv", 6)
$billsArray5 = StringSplit($billsRawData5, ",")
$billsRawData6 = FileReadLine(#AppDataDir & "\testDir\test.csv", 7)
$billsArray6 = StringSplit($billsRawData6, ",")
$billsRawData7 = FileReadLine(#AppDataDir & "\testDir\test.csv", 8)
$billsArray7 = StringSplit($billsRawData7, ",")
$billsRawData8 = FileReadLine(#AppDataDir & "\testDir\test.csv", 9)
$billsArray8 = StringSplit($billsRawData8, ",")
$billsRawData9 = FileReadLine(#AppDataDir & "\testDir\test.csv", 10)
$billsArray9 = StringSplit($billsRawData9, ",")
$billsRawData10 = FileReadLine(#AppDataDir & "\testDir\test.csv", 11)
$billsArray10 = StringSplit($billsRawData10, ",")
$billsRawData11 = FileReadLine(#AppDataDir & "\testDir\test.csv", 12)
$billsArray11 = StringSplit($billsRawData11, ",")
$billsRawData12 = FileReadLine(#AppDataDir & "\testDir\test.csv", 13)
$billsArray12 = StringSplit($billsRawData12, ",")
$billsRawData13 = FileReadLine(#AppDataDir & "\testDir\test.csv", 14)
$billsArray13 = StringSplit($billsRawData13, ",")
$billsRawData14 = FileReadLine(#AppDataDir & "\testDir\test.csv", 15)
$billsArray14 = StringSplit($billsRawData14, ",")
$billsRawData15 = FileReadLine(#AppDataDir & "\testDir\test.csv", 16)
$billsArray15 = StringSplit($billsRawData15, ",")
$billsRawData16 = FileReadLine(#AppDataDir & "\testDir\test.csv", 17)
$billsArray16 = StringSplit($billsRawData16, ",")
$billsRawData17 = FileReadLine(#AppDataDir & "\testDir\test.csv", 18)
$billsArray17 = StringSplit($billsRawData17, ",")
$billsRawData18 = FileReadLine(#AppDataDir & "\testDir\test.csv", 19)
$billsArray18 = StringSplit($billsRawData18, ",")
$billsRawData19 = FileReadLine(#AppDataDir & "\testDir\test.csv", 20)
$billsArray19 = StringSplit($billsRawData19, ",")
$billsRawData20 = FileReadLine(#AppDataDir & "\testDir\test.csv", 21)
$billsArray20 = StringSplit($billsRawData20, ",")
$total = $billsArray1[3] + $billsArray2[3]; + $billsArray3[3] + $billsArray4[3] + $billsArray5[3] + $billsArray6[3] + $billsArray7[3] + $billsArray8[3] + $billsArray9[3] + $billsArray10[3] + $billsArray11[3] + $billsArray12[3] + $billsArray13[3] + $billsArray14[3] + $billsArray15[3]; + $billsArray16[3] + $billsArray17[3] + $billsArray18[3] + $billsArray19[3] + $billsArray20[3]
MsgBox(0, "", $total)
test.csv
,,,
10/04/2015, Internet,$40 , Monthly
10/07/2015, Gas,$80 , Monthly
10/01/2015, Cable,$60 , Monthly
10/27/2015, Storage,$50 , Monthly
10/30/2015,School,$150 , Monthly
10/18/2015,Rent,$750 ,Monthly
test.csv contains variable amount of rows. I'm trying to add the value in the third column. I read each line into a variable and split that into an array ($billsArray1[3] returns $40). I then add these variables together, but it returns 0 for $total.
1) Why is $total returning 0 instead of the total?
2) How to create a loop to assign the variables (so I don't need to create new variables for each line, as I don't know how many lines there will be)? Note* it always skips the first line so it starts at line 2.
3) How to create another loop to add the data in the third column together?
I wouldn't create a separate array. I'd just loop over the file, grab the 3rd entry, strip everything that isn't a number (like $) and then add that to the total...
$file = FileOpen(#AppDataDir & "\testDir\test.csv", 0)
$total = 0
While 1
$line = FileReadLine($file)
If #error = -1 Then ExitLoop
;Get the 3rd "token" and strip everything that is not a number.
$bill = StringRegExpReplace(StringSplit($line, ',')[3], "[^\d]", "")
;Add current bill to total.
$total = $total + $bill
WEnd
FileClose($file)
MsgBox(0, "Total", $total)