I have an issue with VBA Script.
I'm trying to use CountIf function with filtering
Sub test31()
Debug.Print "Sum Visible Cells only: " & Application.WorksheetFunction.Sum(Sheets("Sheet1").Range("A2:A645").SpecialCells(xlCellTypeVisible))
If Application.WorksheetFunction.CountIf(Sheets("Sheet1").Range("A2:A645").SpecialCells(xlCellTypeVisible), 1) > 0 Then
Debug.Print "Ok"
End If
End Sub
Example
Question:
When I mark in filter (for example, please see attached image) first, third, fourth, fifth, etc. (but if I unmark some of number between this scope I am getting error "unable to get countif property of the worksheetfunction class" (but when I mark everything or mark first 2 or 3, etc (without unmarking like in image) error does not appear)
The file
COUNTIF does not seem to like non-contiguous blocks which will happen when you get the list filters and rows disappear. But this I mean ticking 2 means range of visible is A1: A2 and A10:A645.
You need to consider using another function.
COUNTA will count non blanks. So we ask it to count the number of non blanks in the visible range. Note we make a range object as it makes the code easier to read and later parameterise.
NEW CODE
Sub test31()
Dim rng As Range
Set rng = ThisWorkbook.Sheets("Sheet1").Range("A2:A645")
Debug.Print "Sum Visible Cells only: " & Application.WorksheetFunction.Sum(rng.SpecialCells(xlCellTypeVisible))
' to see non contiguous uncomment this next line
' rng.SpecialCells(xlCellTypeVisible).Select
If Excel.WorksheetFunction.CountA(rng.SpecialCells(xlCellTypeVisible)) > 0 Then
Debug.Print "Ok"
Debug.Print "number visible: " & Excel.WorksheetFunction.CountA(rng.SpecialCells(xlCellTypeVisible))
End If
End Sub
OUTPUT
testing all in filter
Sum Visible Cells only: 3337
Ok
number visible: 643
testing with 2 unselected
Sum Visible Cells only: 3323
Ok
number visible: 636
I am not sure of your desired output but hope this helps.
Lure
Second attempt at answering your question.
First you are using a worksheet function countif in your vba in the form
worksheetfunction.countif( rng , 1 )
and rng is required to be a single range.
Next you are using the methods Sheets("Sheet1").Range("A2:A645").SpecialCells(xlCellTypeVisible) specifically SpecialCells, which is returning a range, but the range is not a single continguous block. Instead, if you debug through your code, and put a watch on this range, then you see that the property Areas actually has a count of 2.
Set rng = Sheets("Sheet1").Range("b2:b645").SpecialCells(xlCellTypeVisible)
Set areaCount = rng.Areas.Count
So the problem is not with your CountIf method, but rather that the Range you are passing into CountIf is made up of different ranges, ie it is of the wrong type.
CountIf can therefore not work for you in this scenario. What you need to use is a worksheet function that allows for working with filtered datasets.
So the function Subtotal which does take a list of ranges seems to be a more appropriate WorksheetFunction for your needs. Now you need to choose an appropriate Aggregate method for the first parameter, which for you is 2 or 3. Count numbers only : 2 or count none blank cells : 3.
Usefully the Aggregate function provides a list of aggregations you can use.
You can now also use the Aggregate function or Subtotal function to Sum your visible ranges, by using the Aggregate function Sum : 9.
Putting all of this together here is a suggested code snippet for you..
Sub test31()
Dim rngToUse As Range
Dim visibleSum As Long
Dim countOfVisible As Long
Set rngToUse = Sheets("Sheet1").Range("b2:b645")
visibleSum = WorksheetFunction.Subtotal(9, rngToUse)
countOfVisible = WorksheetFunction.Subtotal(3, rngToUse)
Debug.Print "Sum Visible Cells only: " & visibleSum
Debug.Print "Count of Visible Cells : " & countOfVisible
If countOfVisible > 0 Then
Debug.Print "Ok"
End If
End Sub
I hope that was a little more useful and informative.
Regards
Gareth
Related
I am looking for reverse vlookup with more than 255 characters in Excel VBA.
This is the formula based one which I took from this website.
=INDEX(F2:F10,MATCH(TRUE,INDEX(D2:D10=A2,0),0))
I have try to convert it in VBA. Here below sample code
Sub test()
'concat
Range("i1") = WorksheetFunction.TextJoin(" ", True, Range("g1:h1"))
'lookup
Sal1 = Application.WorksheetFunction.Index(Sheets("sheet1").Range("a1:a2"), Application.WorksheetFunction.Match(True, Application.WorksheetFunction.Index(Sheets("sheet1").Range("i1:i1") = Range("i1").Value, 0), 0))
'=INDEX($W$3:$W$162,MATCH(TRUE,INDEX($W$3:$W$162=U3,0),0))
End Sub
It works well but it didn't when i change the range("i1:i1") to range("i1:i2")
I'm not sure what that worksheet formula does that =INDEX(F2:F11,MATCH(A2,D2:D11,FALSE)) doesn't do.
This part Index(Sheets("sheet1").Range("i1:i2") = Range("i1").Value, 0) is comparing a 2-d array to a single value, which should result in a Type Mismatch error. Whenever you reference a multi-cell range's Value property (Value is the default property in this context), you get a 2-d array even if the range is a single column or row.
You could fix that problem with Application.WorksheetFunction.Transpose(Range("D1:D10")) to turn it into a 1-d array, but I still don't think you can compare a 1-d array to a single value and have it return something that's suitable for passing into INDEX.
You could use VBA to create the array's of Trues and Falses, but if you're going to go to that trouble, you should just use VBA to do the whole thing and ditch the WorksheetFunction approach.
I couldn't get it to work when comparing a single cell to a single cell like you said it did.
Here's one way to reproduce the formula
Public Sub test()
Dim rFound As Range
'find A2 in D
Set rFound = Sheet1.Range("D1:D10").Find(Sheet1.Range("A2").Value, , xlValues, xlWhole)
If Not rFound Is Nothing Then
MsgBox rFound.Offset(0, 2).Value 'read column f - same position as d
End If
End Sub
If that simpler formula works and you want to use WorksheetFunction, it would look like this
Public Sub test2()
Dim wf As WorksheetFunction
Set wf = Application.WorksheetFunction
MsgBox wf.Index(Sheet1.Range("F2:F11"), wf.Match(Sheet1.Range("A2").Value, Sheet1.Range("D2:D11"), False))
End Sub
Function betterSearch(searchCell, A As Range, B As Range)
For Each cell In A
If cell.Value = searchCell Then
betterSearch = B.Cells(cell.Row, 1)
Exit For
End If
betterSearch = "Not found"
Next
End Function
i found this code from above link and it is useful for my current search.Below examples i try to get value..
Kindly consider Row 1 to 5 as empty for A and B column because my table always start from Row 6
Row
A Column
B Column
6
54
a
7
55
b
8
56
c
VBA Code:
Sub look_up ()
Ref = "b"
look_up = betterSearch(Ref, Range("B6:B8"), Range("A6:A8"))
End Sub
it show Empty while use Range("B6:B8"), Range("A6:A8")
but when changing the range from B6 and A6 to B1 and A1 (Range("B1:B8"), Range("A1:A8") )it gives the value...
My question is "can get the values from desired range"
Expressing matches via VBA
I like to know if there (are) any possibilities to convert this formula.
=INDEX(F2:F10,MATCH(TRUE,INDEX(D2:D10=A2,0),0))
So "reverse VLookUp" in title simply meant to express the (single) formula result via VBA (btw I sticked to the cell references in OP, as you mention different range addresses in comments).
This can be done by simple evaluation to give you a starting idea:
'0) define formula string
Dim BaseFormula As String
BaseFormula = "=INDEX($F$2:$F$10,MATCH(TRUE,INDEX($D$2:$D$10=$A2,0),0))"
'1) display single result in VB Editor's immediate
Dim result
result = Evaluate(BaseFormula)
Debug.Print IIf(IsError(result), "Not found!", result)
On the other hand it seems that you have the intention to extend the search string range
from A2 to more inputs (e.g. till cell A4). The base formula wouldn't return a results array with this formula,
but you could procede as follows by copying the start formula over e.g. 3 rows (note the relative address ...=$A2 to allow a row incremention in the next rows):
'0) define formula string
Dim BaseFormula As String
BaseFormula = "=INDEX($F$2:$F$10,MATCH(TRUE,INDEX($D$2:$D$10=$A1,0),0))"
'2) write result(s) to any (starting) target cell
'a)Enter formulae extending search cells over e.g. 3 rows (i.e. from $A2 to $A4)
Sheet3.Range("H2").Resize(3).Formula2 = BaseFormula
'b) optional overwriting all formulae, if you prefer values instead
'Sheet3.Range("H2").Resize(3).Value = Tabelle3.Range("G14").Resize(3).Value
Of course you can modify the formula string by any dynamic replacements (e.g. via property .Address(True,True,External:=True) applied to some predefined ranges to obtain absolute fully qualified references in this example).
Some explanations to the used formulae
The formula in the cited link
=INDEX(F2:F10,MATCH(TRUE,INDEX(D2:D10=A2,0),0))
describes a way to avoid an inevitable #NA error when matching strings with more than 255 characters directly.
Basically it is "looking up A2 in D2:D10 and returning a result from F2:F10" similar to the (failing) direct approach in such cases:
=INDEX(F2:F11,MATCH(A2,D2:D11,FALSE))
The trick is to offer a set of True|False elements (INDEX(D2:D10=A2,0))
which can be matched eventually without problems for an occurence of True.
Full power by Excel/MS 365
If, however you dispose of Excel/MS 365 you might even use the following much simpler function instead
and profit from the dynamic display of results in a so called spill range.
That means that matches can be based not only on one search string, but on several ones (e.g. A1:A2),
what seems to solve your additional issue (c.f. last sentence in OP) to extend the the search range as well.
=XLOOKUP(A1:A2,D2:D10,F2:F10,"Not found")
For example. I want my intro sheet "Main Sheet" to have an option to switch the workbook between currencies. USD and AED at the rate of 3.68. Some cells are referencing other cells in different sheets, so I don't want to change the cell references, I only need to calculate the rate in specific cells within each sheet.
How can I accomplish this preferably using a check box or button for easy converting from the start. I'm using excel for Mac. Thank you
Create a cell with a validation drop-down allowing to choose between AED and USD. Convert that cell to a named range for easy referencing throughout the workbook. You might call it "Curr", short for "Currency" (short because it will be used often).
I recommend that you create a similar cell somewhere where you enter the rate, currently 3.68 but plan on changing the rate in that cell only and have it applied to all the workbook. Name that cell as "Rate".
Now all cells containing values which you may want switched would be subject to the following formula. =[CellValue] * IF(Curr = "AED", Rate, 1). This formula presumes that the values are all entered in USD. If they are entered in AED the formula should look as follows. = ROUND([CellValue] / IF(Curr = "AED", 1, Rate), 2)
As you see, this solution would require the original cell values to be recorded somewhere, meaning, the cells used for data capture can't be the same as the ones used for data display. If you wish to insist on capture and display being in the same cell you would need code to do the conversion.
On the face of it this seems simple: When the Curr selection is changed, all cells with affected values are re-calculated. In practise this would end in disaster because there are 1001 ways in which something might go wrong and then you would lose all your data, not knowing whether the values are USD or AED at that moment.
Therefore the starting point needs to be to separate data capture and data display. Once that is done workheet functions might well be not only the easiest but also the most efficient way of achieving what you want.
I'm going to assume that you want to have the conversion on the input cell and not all of your cells are formulas and that a lot of the cells you want to convert are values. You should seriously consider the answer to split out input vs display, it will be much more foolproof and protected from any logic that may break your workbook.
If you're keen on this pathe then do the following, but, before you do ... BACKUP YOUR WORKBOOK. Any tests I've done with the below code are not breaking but I don't have your workbook, therefore, I make no guarantees.
Firstly, you need a cell that gives you the current exchange rate. You need to give that cell a named range of ExchangeRate.
In my workbook, that cell contains a formula ...
=IF(B1="USD",1,3.68)
It looks like this ...
... and cell B1 has a validation attached to it that allows you to select from 2 currencies, AED or USD.
You said you want to be able to ensure that only a selection of cells will be converted. To make sure we ring fence just those cells, you need to create a named range ON EACH SHEET that includes all of those cells.
The name of that range needs to be called CellsToConvert and you can do that through the Name Manager. When creating the named range, make sure you specify the worksheet you're creating it for, do not selected the "Workbook" option.
... the below shows the sporadic range I used on the first sheet. All coloured cells a part of that range. The green cells contain values and the yellow cells contain formulas.
At the end of the day, that range can be huge and across different sheets but it should work.
Now, add the following code into the ThisWorkbook object within the VBA editor ...
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim objCell As Range, dblExRate As Double, strFormula As String, objSheet As Worksheet
Dim strNewFormula As String, strOpeningChar As String, bIsFormula As Boolean
Dim objCells As Range, strError As String, strExRateRangeName As String
strExRateRangeName = "ExchangeRate"
dblExRate = Range(strExRateRangeName)
Application.EnableEvents = False
For Each objSheet In Worksheets
On Error Resume Next
strError = ""
Err.Clear
Set objCells = objSheet.Range("CellsToConvert")
strError = Err.Description
On Error GoTo 0
If strError = "" Then
For Each objCell In objCells
strFormula = objCell.FormulaR1C1
bIsFormula = False
' Check to make sure this field contains a formula.
If Left(strFormula, 1) = "=" And objCell.NumberFormat <> "#" Then
bIsFormula = True
End If
If dblExRate = 1 Then
' Base currency selected.
' Check to see if the cell contains a formula, if it does,
' convert it back to a value
If bIsFormula Then
' It's a formula and the cell is not set to text, proces it back
' to its original value, that could still be a formula.
' Remove all of the exchange rate components we would've added as
' a part of this routine.
strNewFormula = Replace(strFormula, ") * " & strExRateRangeName, "")
' Check to see if the formula has changed against the previous statement,
' if it has, then it contained the custom additions, otherwise, it didn't.
If strFormula <> strNewFormula Then
strNewFormula = Mid(strNewFormula, 3)
' Check to see if the new value is numeric, if it is, remove the leading
' equals sign as it wasn't originally a formula, or, at least it doesn't
' need to be a formula.
If IsNumeric(strNewFormula) Then
objCell.Value = strNewFormula
Else
objCell.FormulaR1C1 = "=" & strNewFormula
End If
End If
End If
Else
' Something other than the base currency has been selected.
strNewFormula = objCell.FormulaR1C1
If InStr(1, strNewFormula, strExRateRangeName, vbTextCompare) = 0 Then
If bIsFormula Then strNewFormula = Mid(objCell.FormulaR1C1, 2)
objCell.FormulaR1C1 = "=(" & strNewFormula & ") * " & strExRateRangeName
End If
End If
Next
End If
Next
Application.EnableEvents = True
End Sub
... once you've done all of the above, it should work for you. Performance could be tested if the workbook is large but that's something you'll need to check for yourself.
If you change a cell and it's within one of those ranges AND the currency of USD is not selected, you'll see the input value changed to a formula after you hit enter. That's pretty neat when you think about it but may not be for you.
One last thing to note, if your range contains broken links, the calculation for that sheet will fail and my code will not notify you of that.
This adds another option for you but is riskier than the first answer. There's nothing like options. :-)
I am working with two different Worksheets in one workbook. My task is to look up the model# of a product from Sheet1, find that same model# in Sheet2, and get the cost of that product, which is located a few columns away.
So naturally, I tried to use Vlookup, because that function is enough for this query.
I will post my code below, and then explain the problems I am facing. I am new to VBA and have searched many many different Stack posts, and tried the various solutions, to no avail.
Private Sub CommandButton1_Click()
Dim tbdCell As Range
Dim model As Range
Dim cell As Range
Dim PAsheet As Worksheet
Dim DB As Worksheet
Dim target As Variant
Set DB = Worksheets("Database")
Set PAsheet = Sheets("Pricing Agreement")
Set tbdCell = Range("N2:N4700")
On Error GoTo ErrHandler:
For Each cell In tbdCell
Set model = cell.Offset(0, -6)
cell = WorksheetFunction.VLookup((CStr(model)), PAsheet.Range(CStr("C2:D2000")), 6, True)
Next cell
Exit Sub
ErrHandler:
Select Case Err.Number
Case 0
Case 1004
cell = "missing"
Resume Next
Case Else
MsgBox Err.Number & vbNewLine & Err.Description
Exit Sub
End Select
End Sub
So upon debugging and testing, most things work until we get to the line where I use the Vlookup function. I invariably get error 1004, even though the data exists in the other spreadsheet. So the cells that I need to fill will always fill with "missing" as posted above in the Error Handling Code.
I tried using the Application version of the function. I tried using different variables and declaring them as Variant type. I even tried making the table_array range just one row with 2 column coverage, in an attempt to force a match for one particular model #. So far, to avoid a type mismatch, I cast 'model'(the model#) into a String, and I also cast the search range in PAsheet to String. The final thing I tried was to not search for an exact match(last argument was set to true)
So in anticipation of future questions about the data that the Vlookup is based on, I will include necessary information about how both sheets are formatted.
Info that you may need:
We start in column N, where the prices are missing in Sheet1(Database).
I set model to the value in the same row, 6 columns to the left(Column H).
Testing with MsgBox proved this to work for me, and on debug, the model variable displays the correct info, so this isn't the issue.
In PAsheet, the model #s are in column C. Originally I made the search table from C2:C2000 or so, but I was led to believe that you need at least a two column table for Vlookup to work, so I changed C2000 to D2000. Now the search range is a two column table.
In PAsheet, the cost of the product is in Column H, which is 5 away from column C. I need this value, so I put 6 in the column_index argument. It was 5 before, because I thought that you didn't count the first column, but I fixed that.
Finally I mostly tested with "False" as the last argument, but either way it doesn't work.
So after trying more than two dozen variations and strategies, I still get "missing" in the cells that I need to fill.
So, what am I doing wrong here? Thanks in advance.
If you are trying to return the 6th value from Column C your range needs to be updated to `PAsheet.Range("C2:H2000")
cell.Value = WorksheetFunction.VLookup(cell.Offset(, -6), PAsheet.Range("C2:H2000"), 6, False)
I would like to swap selected cell ranges within the same column without having automatically adjusted attached formulas in other columns. Those cell ranges will almost always be of unequal size.
I found a VBA code which does it for two selected cells, but im afraid that this wont help me much.
Sub SwapCells()
Dim sHolder As String
If Selection.Cells.Count = 2 Then
With Selection
sHolder = .Cells(1).Formula
If .Areas.Count = 2 Then ' Cells selected using Ctrl key
.Areas(1).Formula = .Areas(2).Formula
.Areas(2).Formula = sHolder
Else ' Adjacent cells are selected
.Cells(1).Formula = .Cells(2).Formula
.Cells(2).Formula = sHolder
End If
End With
Else
MsgBox "Select only TWO cells to swap", vbCritical
End If
End Sub
I know that another option would be to hold 'shift' when moving the cell ranges (works perfectly fine), but then all the attached formulas will change their reference which I dont want (e.g. if I have a formula referring to cell A1, and im swapping A1 somewhere, the formula will refer to A1's new position, but I want the formula to still refer to A1).
I think another option would be to use INDIRECT("G" & ROW()) to fix it, but since its a quite resource-intensive formula, Id love to see an alternative.
On top of that, the latter two options would not allow me to use tables (which Id prefer for other reasons) because you cant swap cells in tables. This is why Id strongly prefer a VBA option.
I hope you can help me, thank you! Maybe it is only necessary to adjust the VBA code a little.
Kind regards,
Marco
EDIT: If it is significantly easier to swap two equal cell ranges (e.g. encompassing 5 cells each), then it would also be a good solution.
Sub SwapTwoSelectedRanges()
Dim initialRng As Range
Set initialRng = Selection
If initialRng.Areas.Count <> 2 Then
Debug.Print "Select 2 areas!"
Exit Sub
End If
If initialRng.Areas(1).Cells.Count <> initialRng.Areas(2).Cells.Count Then
Debug.Print "The cells should be the same number!"
Exit Sub
End If
Dim intermediateRng As Variant
intermediateRng = initialRng.Areas(1).Cells.Value2
initialRng.Areas(1).Cells.Value2 = initialRng.Areas(2).Cells.Value2
initialRng.Areas(2).Cells.Value2 = intermediateRng
End Sub
Swaping two values is considered an easy task, if you are using an intermediate value. With the ranges, there are two important checks to perform, before swapping them:
Are the selected areas exactly 2;
Is the number of cells equal in every area;
Then with an intermediateRng as a 3. variable, the swap is made;
This would only work, if the Areas are per column. If the selection is made per row, then the results would not be as expected;
Concerning the swaping of the colors, if the colors of all the cells per area are exactly the same, this would work:
Dim intermediateRng As Variant
Dim intermediateClr As Variant
intermediateRng = initialRng.Areas(1).Cells.Value2
intermediateClr = initialRng.Areas(1).Cells.Interior.Color
With initialRng
.Areas(1).Cells.Value2 = .Areas(2).Cells.Value2
.Areas(1).Cells.Interior.Color = .Areas(2).Cells.Interior.Color
.Areas(2).Cells.Value2 = intermediateRng
.Areas(2).Cells.Interior.Color = intermediateClr
End With
However, if the colors of the cells per Area are not the same, then the easiest way is to copy+paste the first range to a separate range and work from there.
I have a sheet of data and am attempting to check column E10 TO I610 to see if the values in there are more than 11538 and the value in cell J5 is "weekly". If the conditions are true, add the values that are more than 11538 and multiply them by 8.4. How do I go about doing this?
Not too strong with vba so please bear with me.
If schedType = "Weekly" And Range("E10,I610").Value > 11538 Then
Range("H6").Value = "WOW"
ElseIf schedType = "Monthly" Then
Range("H6").Value = "10"
End If
I tried the above way to achieve what I want. Though the code above wont do the exact calculations im after, its just a test. Like I said, I'm attempting to search the range E10 to I610 for any values greater than 11538, then total them and finally find 8.4% of the total.
Its a bit complicated and any assistance is greatly appreciated.
This doesn't work for a lot of reasons, not the least of which is this:
Range("E10,I610").Value
For starters, Range("E10,I610") is a range of only two cells, you guessed it: E10 and I10. Use a colon to create a continuous range object, Range("E10:I610"). Furthermore, the .Value property of a multi-cell range will always, only return the value in the top, left cell.
So, since the value of E10 was not > 11538, the first If statement returns False, and the rest of your code within that block is omitted.
Then, it will continues to fail because you have not structured the code correctly.
There are several ways to work with multiple cells/ranges, I will give you one example which is not very efficient, but it will work for your purposes. I will use a For each loop to iterate over every cell in the Range("E10:I610"), and then check those values against 11538, summing the values greater than 11538.
Sub TotalCells()
Dim schedType as String
Dim rng as Range
Dim cl as Range
Dim myTotal as Double
Set rng = Range("E10:I610")
schedType = Range("J5").Value
'## Check what schedType we are working with:
If schedType = "Weekly" Then
For each cl in rng.Cells
If cl.Value > 11538 Then myTotal = myTotal + cl.Value
Next
'## Multiply the sum by 8.4%
myTotal = 0.084 * myTotal
'## Display the result:
MsgBox "The weekly total is: " & myTotal, vbInformation
ElseIf schedType = "Monthly" Then
' You can put another set of code here for Monthly calculation.
End If
## Print the total on the worksheet, cell H6
Range("H6").Value = myTotal
End Sub
As I said, this is not efficient, but it illustrates a good starting point. You could also use formulas like CountIfs or SumIfs or use the worksheet's AutoFilter method and then sum the visible cells, etc.
In the future, it is always best to post all, or as much of your code as possible, including the declaration of variables, etc., so that we don't have to ask questions like "What type of variable is schedType?"