Excel VBA sumproduct with Criteria - vba

Need help with writing this Excel function into a Macro, please help
A1=7 B1=1 C1=4
A2=8 B2=2 C2=5
A3=9 B3=3 C3=6
if A1 = A1(7), answers will equal to B1 * C1 = 1*4 = 4
if A1 = A2(8), answers will equal to B2 * C2 = 2*5 = 10
the function works perfectly in the excel cell,
SUMPRODUCT((A1:A3=A1)+0,B1:B3,C1:C3)
however, the vba doesn't not work.
With Worksheets("Sumproduct")
.Range("D1").Value = Application.WorksheetFunction.SumProduct((.Range("A1:A3" = A1)+ 0 , .Range("B1:B3"), .Range("C1:C3"))`

Related

Adjusting row height if tables in word using vba

I have a template based on the repetition of two pages with two different tables. I am working on a macro to adjust the row heights of these tables throughout the document so that the row heights are the same. Sometimes the tables stay on the page, sometimes it does overflows continuously onto a new page.
I have been trying a few different ways and the below is the closest I have come to getting it to work. Below gets the actual row height by looking at the position against the document. The issue I am having is that the tables are crossing pages and so keeps showing an error when it gets to a row on the next page. The error is 'The measurement must be between 0 pt and 1584 pt.'
This is the code I am currently using:
A = 1
B = 2
While B <= ActiveDocument.Tables.Count
Set T1 = ActiveDocument.Tables(A)
Set T2 = ActiveDocument.Tables(B)
Set R1 = T1.Rows
Set R2 = T2.Rows
Set C1 = T1.Columns
Set C2 = T2.Columns
For i = 1 To R1.Count()
If i = R1.Count() Then
Else
H1 = T1.Rows(i + 1).Range.Information(wdVerticalPositionRelativeToPage) _
- T1.Rows(i).Range.Information(wdVerticalPositionRelativeToPage)
H2 = T2.Rows(i + 1).Range.Information(wdVerticalPositionRelativeToPage) _
- T2.Rows(i).Range.Information(wdVerticalPositionRelativeToPage)
If H1 > 0 Or H1 < 1584 Or H2 > 0 Or H2 < 1584 Then
If H1 > H2 Then
R2(i).Height = H1
Else
R1(i).Height = H2
End If
End If
End If
Next
A = A + 1
B = B + 2
Wend
I have also tried setting the height using the below, which doesn't work in this case as it only gets the default height of the row and not the actual height.
H1 = R1(i).Height
H2 = R2(i).Height
Thank you for any help in advance.
Thank you to everyone who helped. I ended up resolving this by using the following code and making the page of the document extremely long. Not ideal, but worked.
Sub rowHeight()
A = 2
B = 4
While B <= ActiveDocument.Tables.Count
Set T1 = ActiveDocument.Tables(A)
Set T2 = ActiveDocument.Tables(B)
Set r1 = T1.Rows
Set r2 = T2.Rows
Set C1 = T1.Columns
Set C2 = T2.Columns
On Error Resume Next
For i = 1 To r1.Count()
If i = r1.Count() Then
Else
H1 = T1.Rows(i + 1).Range.Information(wdVerticalPositionRelativeToPage) _
- T1.Rows(i).Range.Information(wdVerticalPositionRelativeToPage)
H2 = T2.Rows(i + 1).Range.Information(wdVerticalPositionRelativeToPage) _
- T2.Rows(i).Range.Information(wdVerticalPositionRelativeToPage)
'H1 = R1(i).Height
'H2 = R2(i).Height
If H1 > 0 & H1 < 1584 & H2 > 0 & H2 < 1584 Then
If H1 > H2 Then
r2(i).Height = H1
Else
r1(i).Height = H2
End If
End If
End If
Next
A = A + 4
B = B + 4
Wend
End Sub

VBA code number formatting

With the below code I am trying to format cells when certain names appear in a drop down list(cell C4) and format these specific cells in Range G9:N9. But when I run the code it converts all numbers into percents appose to differentiating between the two formatting styles (Percent and General). Can anyone help?
Sub LetsMakeThisWork()
With Worksheets("Geo")
If C4 = V2 Or C4 = x2 Or C4 = AB2 Or C4 = AD2 Or C4 = AG2 Or C4 = AM2 Or C4 = AO2 Or C4 = AQ2 Or C4 = AU2 Or C4 = AW2 Then
ActiveCell.Range("G9:N9").NumberFormat = "0.0%"
Else
ActiveCell.Range("G9:N9").NumberFormat = "General"
End If
End With
End Sub
In context, you intend C4, V2 etc. to be a cell references but VBA is interpreting them as variables. The fact that your code runs at all in that case implies that you are not using Option Explicit, which you really should use in VBA. What seems to be happening is that you are implicitly creating empty variables in the process of testing them for equality. Any two empty variables are equal, hence the first clause of the If statement is always run. Corrected, but not tested, your code should (I think) look like this:
Option Explicit
Sub LetsMakeThisWork()
Dim C4 As Range
With Worksheets("Geo")
Set C4 = .Range("C4")
If C4.Value = .Range("RV2").Value Or C4.Value = .Range("X2").Value Or _
C4.Value = .Range("AB2").Value Or C4.Value = .Range("AD2").Value Or _
C4.Value = .Range("AG2").Value Or C4.Value = .Range("AM2").Value Or _
C4.Value = .Range("AO2").Value Or C4.Value = .Range("AQ2").Value Or _
C4.Value = .Range("AU2").Value Or C4.Value = .Range("AW2").Value Then
.Range("G9:N9").NumberFormat = "0.0%"
Else
.Range("G9:N9").NumberFormat = "General"
End If
End With
End Sub

Sumproduct not working

Hi I need to execute my excel formula on vba. Here's the formula:
=((SUMPRODUCT(-(Details!$C$7:$C$1182=A3),-(Details!$E$7:$E$1182=B3), -(Details!$S$7:$S$1182="Delivered"), -(Details!$G$7:$G$1182=C3), Details!$N$7:$N$1182)))
And my code is:
ws1.Range("I2:I" & last) = Evaluate("SumProduct(-(Details!C = A3), -(Details!E = B3), -(Details!S = 'Delivered'), -(Details!G = C3), Details!N)")
My sumproduct takes values from other sheets, but it is not working. Thanks.
Write -- instead of - for your logical tests
Evaluate("SumProduct(--(Details!C = A3), --(Details!E = B3), --(Details!S = 'Delivered'), --(Details!G = C3), Details!N)")

Excel UDF arguments returning cell references instead of values

This is my first foray into user defined functions since Excel 7.0. So I'm pretty sure I'm making a newbie error.
I'm getting a #VALUE error in the cell where I've entered the formula. When I use Error Checking to Show Calculation Steps, it evaluates the functions arguments as the cell references rather than values.
The formula in the cell:
=PavementNPV(P2, U2, T2, R2, Y2, Z2, AA2, I2, J2, K2, B2, W2, V2, X2)
Error checking window says the formula exactly with all cell references underline and X2 italicized. At the bottom is the message that the next evaluation will cause an error. The error is #VALUE.
The values in the cells:
P2 = 10
U2 = 63.17986
T2 = 10
R2 = 3
Y2 = $0.28
Z2 = $1.32
AA2 = $2.58
I2 = 14000
J2 = 45
K2 = 60
B2 = 292
W2 = 73.17986
V2 = 8
X2 = 0.05
The code:
Function PavementNPV(AssumedLife, PvmtCondition, AgeByCondition, Curve, CarVOC As Currency, BusVOC As Currency, TruckVOC As Currency, AvgDailyTraffic, TruckCount, BusCount, SegLength, RestPCTGain, RestAgeByCondition, Rate) As Currency
'Calculate Yr1 restored PCI(PvmtCondition - Pavement Condition Index) value
' =PvmtCondition + Assumed Life
Dim Yr1RestPCI
Yr1RestPCI = PvmtCondition + AssumedLife
'For each year of Assumed life, calculate doNothingTotalAnnualVOCIncreaseRange and restoredTotalAnnualVOCIncreaseRange:
' =365*(CarVOCIncrease% as (Application.WorksheetFunction.VLOOKUP((PCIofYr as (If Yr1 then PvmtCondition, else 100*(1/(1+EXP((AgeByCondition+year(e.g. 2)-1)/Application.WorksheetFunction.VLOOKUP(Curve,Table4[#All],2,FALSE)-Application.WorksheetFunction.VLOOKUP(Curve,Table4[#All],3,FALSE))))*Application.WorksheetFunction.VLOOKUP(Curve,Table4[#All],4,FALSE)))),'User Cost'!$BC$5:$BF$151,2))*CarVOC*AvgDailyTraffic+BusVOCIncrease%*BusVOC+TruckVOCIncrease%*TruckVOC)*SegLength/5280)
Dim arydoNothingPCI()
ReDim arydoNothingPCI(1 To AssumedLife)
Dim aryRestoredPCI()
ReDim aryRestoredPCI(1 To AssumedLife)
Dim arydoNothingVOCIncrease() As Currency
ReDim arydoNothingVOCIncrease(1 To AssumedLife)
Dim aryRestoredVOCIncrease() As Currency
ReDim aryRestoredVOCIncrease(1 To AssumedLife)
Dim i
arydoNothingPCI(1) = PvmtCondition
aryRestoredPCI(1) = Yr1RestPCI
For i = 2 To AssumedLife
arydoNothingPCI(i) = 100 * (1 / (1 + Application.WorksheetFunction.Exp((AgeByCondition + i) - 1) / Application.WorksheetFunction.VLookup(Curve, "Table4[#All]", 2, False) - Application.WorksheetFunction.VLookup(Curve, "Table4[#All]", 3, False))) * Application.WorksheetFunction.VLookup(Curve, "Table4[#All]", 4, False)
aryRestoredPCI(i) = 100 * (1 / (1 + Application.WorksheetFunction.Exp((RestAgeByCondition + i) - 1) / Application.WorksheetFunction.VLookup(Curve, "Table4[#All]", 2, False) - Application.WorksheetFunction.VLookup(Curve, "Table4[#All]", 3, False))) * Application.WorksheetFunction.VLookup(Curve, "Table4[#All]", 4, False)
Next
'Testing function so far by asking it to return something simple
PavementNPV = CarVOC
'Calculate Total PV Benefits by calculating NPV of doNothing minus NPV or restored
' =Application.WorksheetFunction.NPV(rate,doNothingTotalAnnualVOCIncreaseRange)- Application.WorksheetFunction.NPV(rate,restoredTotalAnnualVOCIncreaseRange)
' or for each NPV =(Yr1VOCIncrease/(1+rate)^1)+(Yr2VOCIncrease/(1+rate)^2)+(Yr3VOCIncrease/(1+rate)^3) etc for all years
End Function
I originally had all of the data types defined, but removed those as my first troubleshooting step. I also originally had the formula entered using Table references (e.g. [#columnname]). I would love to be able to return to that for readability.
Please let me know if you need any additional information to help. Thank you in advance.
Your parameters Arg2 of WorksheetFunction.VLookup are not correct. They can't be strings.
Use
Application.WorksheetFunction.VLookup(Curve, Application.Range("Table4[#All]"), 2, False)
for example.
Another error could be that the WorksheetFunction.VLookup returns the #N/A error because the lookup value could not be found within the table array. In this case the function breaks at this point and returns #Value also. This you could avoid using On Error Resume Next before the calls of WorksheetFunction.VLookup and On Error GoTo 0 after them.
Hint to debug: Have the VBA Editor open. Set a breakpoint somewhere in the function's body. Call the function by input it as formula in a cell. The code stops at the breakpoint. Change to the VBA Editor window and step through the code.

How do I correct this vba code?

I am still new to vba.
I am trying to create a new function however, it keeps giving me an output that I am not expecting.
my code is as follows:
Function bonusplanA(a, b, c)
Dim example As Range
Set example = Range("a:c")
Value = Application.WorksheetFunction.CountIf(example, ">=90")
Value1 = Application.WorksheetFunction.CountIf(example, ">=80")
If Value = 3 Then
bonusplanA = "$20,000 bonus"
Else
If Value1 = 3 Then
bonusplanA = "$10,000 bonus"
Else
bonusplanA = "NO BONUS"
End If
End If
End Function
You need to define your function like this:
Function bonusplanA(a, b, c)
If a >= 90 And b >= 90 And c >= 90 Then
bonusplanA = "$20,000 bonus"
Else
If a >= 80 And b >= 80 And c >= 80 Then
bonusplanA = "$10,000 bonus"
Else
bonusplanA = "NO BONUS"
End If
End If
End Function
The problem in your example was that Range("a:c") does not make a range of your a,b,c variables; instead it selects the range composed of columns A, B and C.
You need to use parameters a, b and c directly, not through the Range function.
Otherwise, the logic was sound. :)