i come to ask your help i need to rank data using vba i have a block of results in column D and i want to rank them in column E without skiping any value so i tried this vba code but it gives me only zeros in all the column then my computer becom slow untill i close the excel file this is the vba code i am using if anyone can help me :
Sub Mactro5()
LastRow = Range("D" & Cells.Rows.Count).End(xlUp).Row
Range("E2:E" & LastRow).Formula = _
"=IF(D2=" & Chr(34) & Chr(34) & "," & Chr(34) & Chr(34) & ",SUMPRODUCT((D$2:D$" & LastRow & ">D2)/COUNTIF(D$2:D$" & LastRow & ",D$2:D$" & LastRow & "&" & Chr(34) & Chr(34) & "))+1)"
End Sub
Related
In VBA I am trying to create a sumifs formula with multiple criteria across different workbooks, but I am struggling on the syntax.
WorkbookRecut.Worksheets("Summary").Activate
Dim CountRows As Long
Dim CountRows2 As Long
CountRows = WorkbookRecut.Worksheets("Summary").Range("I" & WorkbookRecut.Worksheets("Summary").Rows.Count - 1).End(xlUp).Row
CountRows2 = CashBreaksMetricsWorkbookFinal.Worksheets("CSCIG_Cash Breaks Metrics").Range("I" & CashBreaksMetricsWorkbookFinal.Worksheets("CSCIG_Cash Breaks Metrics").Rows.Count - 1).End(xlUp).Row
CashBreaksMetricsWorkbookFinal.Worksheets("CSCIG_Cash Breaks Metrics").Activate
Range("O6").Formula = _
"=Sumifs(" & [WorkbookRecut].Sheets("Summary").Range("I9").Address & ":" & [WorkbookRecut].Sheets("Summary").Range("I" & CountRows).Address _
& "," & [WorkbookRecut].Sheets("Summary").Range("A9").Address & ":" & [WorkbookRecut].Sheets("Summary").Range("A" & CountRows).Address _
& "," & [CashBreaksMetricsWorkbookFinal].Worksheets("CSCIG_Cash Breaks Metrics").Range("K6").Address(Rowabsolute:=False) _
& "," & [WorkbookRecut].Sheets("Summary").Range("D9").Address & ":" & [WorkbookRecut].Sheets("Summary").Range("D" & CountRows).Address _
& "," & [CashBreaksMetricsWorkbookFinal].Worksheets("CSCIG_Cash Breaks Metrics").Range("N6").Address(Rowabsolute:=False) & ")"
CashBreaksMetricsWorkbookFinal.Worksheets("CSCIG_Cash Breaks Metrics").Range("O6:O" & CountRows2).FillDown
Update
I have updated the most recent code. The only pending issue is the workbooks aren't changing, but all else works as I want :)
When creating a formula string to add to a cell you need to take into account where the different ranges are relative to the sheet where you're going to place the formula. Just calling Address() on one of the inputs may not give you what you want.
You can try something like the code below to abstract that part into a separate function:
Sub Tester()
Dim wsSumm As Worksheet, wsCBM As Worksheet
Dim lr As Long, f
Set wsSumm = WorkbookRecut.Worksheets("Summary")
Set wsCBM = CashBreaksMetricsWorkbookFinal.Worksheets("CSCIG_Cash Breaks Metrics")
lr = wsSumm.Cells(Rows.Count, "I").End(xlUp).Row
f = "=SUMIFS(" & RealAddress(wsCBM, wsSumm.Range("I9:I" & lr)) & "," & _
RealAddress(wsCBM, wsSumm.Range("A9:A" & lr)) & ",$K6," & _
RealAddress(wsCBM, wsSumm.Range("D9:D" & lr)) & ",$N6)"
With wsCBM.Range("O9")
.Formula = f
End With
End Sub
'get a range address for `rngRef`,
' suitable for use in a formula on worksheet `ws`
Function RealAddress(ws, rngRef As Range) As String
Dim s As String
If ws.Parent Is rngRef.Worksheet.Parent Then 'same workbooks?
If Not ws Is rngRef.Worksheet Then s = "'" & rngRef.Worksheet.Name & "'!" 'diff. worksheets?
s = s & rngRef.Address(True, True)
Else
s = rngRef.Address(True, True, external:=True) 'different workbooks
End If
RealAddress = s
End Function
For the formula: You're probably looking for the .Address property from each of your Ranges. Something like Range1.Address & ":" & Range2.Address To get an output like $I$9:$I$307.
But for your Ranges, you need to put the CountRows inside the Range input like WorkbookRecut.Sheets("Summary").Range("A" & CountRows) and then add the .Address to it.
I also agree with #TimWilliams that your formula code could benefit greatly in terms of readability by adding some nicknames for your worksheets.
Here is what your code would look like with those 3 things corrected:
Public CashBreaksMetricsWorkbookFinal As Workbook
Public WorkbookRecut As Workbook
Dim SumSh As Worksheet
Set SumSh = WorkbookRecut.Sheets("Summary")
Dim CountRows As Long
CountRows = SumSh.Range("I" & SumSh.Rows.Count - 1).End(xlUp).Row
Dim CSCIG As Worksheet
Set CSCIG = CashBreaksMetricsWorkbookFinal.Worksheets("CSCIG_Cash Breaks Metrics")
CSCIG.Activate
Range("O9").Formula = _
"=Sumifs(" & SumSh.Range("I9") & ":" & SumSh.Range("I" & CountRows).Address _
& "," & SumSh.Range("A9").Address & ":" & SumSh.Range("A" & CountRows).Address _
& "," & CSCIG.Range("K6").Address _
& "," & SumSh.Range("D9").Address & ":" & SumSh.Range("D" & CountRows).Address _
& "," & CSCIG.Range("N6").Address & ")"
CSCIG.Range("O9").FillDown
We were missing .Address(External:=True)
Thanks all for helping me get there (Finally!)
Final Code Below
Public CashBreaksMetricsWorkbookFinal As Workbook
Public WorkbookRecut As Workbook
Dim CountRows As Long
Dim CountRows2 As Long
CountRows = WorkbookRecut.Worksheets("Summary").Range("I" & WorkbookRecut.Worksheets("Summary").Rows.Count - 1).End(xlUp).Row
CountRows2 = CashBreaksMetricsWorkbookFinal.Worksheets("CSCIG_Cash Breaks Metrics").Range("I" & CashBreaksMetricsWorkbookFinal.Worksheets("CSCIG_Cash Breaks Metrics").Rows.Count - 1).End(xlUp).Row
CashBreaksMetricsWorkbookFinal.Worksheets("CSCIG_Cash Breaks Metrics").Activate
Range("O6").Formula = _
"=Sumifs(" & [WorkbookRecut].Sheets("Summary").Range("I9").Address(External:=True) & ":" & [WorkbookRecut].Sheets("Summary").Range("I" & CountRows).Address(External:=True) _
& "," & [WorkbookRecut].Sheets("Summary").Range("A9").Address(External:=True) & ":" & [WorkbookRecut].Sheets("Summary").Range("A" & CountRows).Address(External:=True) _
& "," & [CashBreaksMetricsWorkbookFinal].Worksheets("CSCIG_Cash Breaks Metrics").Range("K6").Address(Rowabsolute:=False) _
& "," & [WorkbookRecut].Sheets("Summary").Range("D9").Address(External:=True) & ":" & [WorkbookRecut].Sheets("Summary").Range("D" & CountRows).Address(External:=True) _
& "," & [CashBreaksMetricsWorkbookFinal].Worksheets("CSCIG_Cash Breaks Metrics").Range("N6").Address(Rowabsolute:=False) & ")"
CashBreaksMetricsWorkbookFinal.Worksheets("CSCIG_Cash Breaks Metrics").Range("O6:O" & CountRows2).FillDown
In the formula, you have to double-quote existing quotes:
Change
Sheets("Summary")
to:
Sheets(""Summary"")
EndRowH = ActiveSheet.Range("H65536").End(xlUp).Row
ActiveSheet.Range("H1").Formula = "=SUMIFS(H3:H" & EndRowH & ", C3:C" & EndRowH & ", "">=" & lngStart & """)"
I Have a criteria on the C column where it has to be greater than the lngStart Value.
The code is working till here.. But I have to add an extra criteria where the sumif needs to be done only if there is blank value in the column I
Dim Blank As Long
Blank = ""
ActiveSheet.Range("H1").Formula = "=SUMIFS(H3:H" & EndRowH & ", C3:C" & EndRowH & ", "">=" & lngStart & "",I3:I" & EndRowH & ", ""!=" & Blank & "" ")"
When working with complex strings you want to put as a Formula, you might want to use an "helper" string, in the code below I use FormulaString, so when you run the Debug.Print line, you can see if the formula string is valid.
Also, and it's only my preference, to get the " inside, I prefer to use Chr(34).
Code
Dim FormulaString As String
FormulaString = "=SUMIFS(H3:H" & EndRowH & ", C3:C" & EndRowH & "," & Chr(34) & ">=" & lngStart & Chr(34) & ",I3:I" & EndRowH & "," & Chr(34) & "<>" & Chr(34) & ")"
Debug.Print FormulaString
ActiveSheet.Range("H1").Formula = FormulaString
Running this code, you will get in the immediate window the following formula:
=SUMIFS(H3:H10, C3:C10,">=5",I3:I10,"<>")
I'd go this way
ActiveSheet.Range("H1").Formula = "=SUMIFS(H3:H" & EndRowH & ", C3:C" & EndRowH & ", concatenate("">=""," & lngStart & "),I3:I" & EndRowH & ", ""="")"
This question already has answers here:
Different languages issue when inserting formula from VBA
(1 answer)
Excel VBA Run-time error 1004 when inserting or value formula into cell
(1 answer)
VBA code string to cell not working - run time error 1004
(1 answer)
Closed 5 years ago.
I have a problem with a formula in VBA. It works in conditional formatting and in excel itself, but I can't use it from VBA level
This is the code:
Range("A1").Formula = "=IF(ISERR(FIND(" & Chr(34) & "-" & Chr(34) & ";" & s_adr_1 & ";2))=FALSE;TRUE;IF(ISERR(FIND(" & Chr(34) & "…" & Chr(34) & ";" & s_adr_1 & ";2))=FALSE;TRUE;IF(ISERR(FIND(" & Chr(34) & ".." & Chr(34) & ";" & s_adr_1 & "))=FALSE;TRUE;IF(ISBLANK(" & s_adr_1 & ");FALSE;IF(AND(IF(ISERR(RIGHT(" & s_adr_1 & ")*1);NOT(ISERR(FIND(" & s_adr_2 & ";" & s_adr_1 & ")));TRUE));FALSE;IF(LEFT(" & s_adr_1 & ")=""#"";FALSE;ISERR(FIND(" & s_adr_2 & ";" & s_adr_1 & "))))))))"
Where s_adr_1 and s_adr_2 are a references to cells so it can look like this as a sample (in B1 there will be my test text, like e.g. "5-15", "15", "5...15"):
Range("A1").Formula = "=IF(ISERR(FIND(" & Chr(34) & "-" & Chr(34) & ";" & "B1" & ";2))=FALSE;TRUE;IF(ISERR(FIND(" & Chr(34) & "…" & Chr(34) & ";" & "B1" & ";2))=FALSE;TRUE;IF(ISERR(FIND(" & Chr(34) & ".." & Chr(34) & ";" & "B1" & "))=FALSE;TRUE;IF(ISBLANK(" & "B1" & ");FALSE;IF(AND(IF(ISERR(RIGHT(" & "B1" & ")*1);NOT(ISERR(FIND(" & "C1" & ";" & "B1" & ")));TRUE));FALSE;IF(LEFT(" & "B1" & ")=""#"";FALSE;ISERR(FIND(" & "C1" & ";" & "B1" & "))))))))"
Expected outcome in A1 would be:
=IF(ISERR(FIND("-";B1;2))=FALSE;TRUE;IF(ISERR(FIND("…";B1;2))=FALSE;TRUE;IF(ISERR(FIND("..";B1))=FALSE;TRUE;IF(ISBLANK(B1);FALSE;IF(AND(IF(ISERR(RIGHT(B1)*1);NOT(ISERR(FIND(C$1;B1)));TRUE));FALSE;IF(LEFT(B1)="#";FALSE;ISERR(FIND(C$1;B1))))))))
It should return TRUE or FALSE.
When I try to run the code I got Error 1004 :(
What is wrong here? Why it works when I paste it in Excel manually?
Assuming that you are using English Excel version, simply use double quotes in the VBA version. Or pretty much do the following:
write the formula in Excel and select the cell, where it is
run this code and mimic the formula, that you get:
-
Public Sub PrintMeUsefulFormula()
Dim strFormula As String
Dim strParenth As String
strParenth = """"
strFormula = Selection.Formula
strFormula = Replace(strFormula, """", """""")
strFormula = strParenth & strFormula & strParenth
Debug.Print strFormula
End Sub
I have numerous cells on a worksheet with the following formula:
=IF(COUNTIF(O7:O9;"Fail");"Fail";"Pass")
I want to replace all the cells with this formula with the following formula:
=IF(COUNTIF(O7:O9;"");"Default";(IF(COUNTIF(O7:O9;"Fail");"Fail";"Pass")))
How can I change them all to the new formula in one swoop? It is a bunch of cells and please notice that all the cells with a formula have different references.
You can just do a ctrl+h and replace the forumulae directly.
This should work
Just select all cells with "those" formulas you mentioned above, If you select any blank cells, or cells with different formulas, it will crash
You can alternatively select a few cells at a time
Sub changeFormulaOfSelectedCells()
Dim rng As Range
Dim rangeInFormula As String
Dim cellFormula As String
For Each rng In Selection
cellFormula = rng.Formula
rangeInFormula = Mid(cellFormula, 13, InStr(cellFormula, ";") - 13)
rng.Formula = "=IF(COUNTIF(" & rangeInFormula & ";" & Chr(34) & Chr(34) & ");" & Chr(34) & "Default" & Chr(34) & ";(IF(COUNTIF(" & rangeInFormula & ";" & Chr(34) & "Fail" & Chr(34) & ");" & Chr(34) & "Fail" & Chr(34) & ";" & Chr(34) & "Pass" & Chr(34) & ")))"
Next rng
End Sub
If you get an error, Just check if I have not missed replacing any , with ;in the above code
I have coded some code in VBA my code breaks at this line raising Application defined or object defined error.
.Formula = "=IF(AND(chr(34) & ' & chr(34) & Criterion " & i & "'!" & cellAdress & ">=1;chr(34) & ' & chr(34) & Criterion " & i & "'!" & cellAdress & "<=4);chr(34) & ' & chr(34) & Criterion " & i & "'!" & cellAdress & ";0)"
I really tried to check what is wrong but it looks fine too me. Please let me know what could be wrong and how to fix it.
Thank you
I think you want
.Formula = "=IF(AND('Criterion " & i & "'!" & cellAdress & ">=1;'Criterion " & i & "'!" & cellAdress & "<=4);'Criterion " & i & "'!" & cellAdress & ";0)"
At least this produces a valid and sensible cell formula, your's does not.
With cellAdress set to "A1" and i set to 10, the result would be:
"=IF(AND('Criterion 10'!A1>=1;'Criterion 10'!A1<=4);'Criterion 10'!A1;0)"
Ok I understand it now. My VBA also doesn't raise any errors until I run. Maybe I'm looking on this code for too long and go crazy. My cell Address contains D18 and i contains 1. I do have a sheet called Criterion 1 and the cell in this sheet has a value of 2 (i also tried when it was empty). Still this error is raised and I don't know what is causing it.