hi Guys just quick question. I am trying to do a Counta / Countif formula in VBA excel. The code I'm working with is the following.
Sub To_open
Dim x as Range
x =COUNTA('Tier 2'!C2:C1000)+COUNTA('Tier 3'!C2:C1000)+COUNTA('Tier 4'!C2:C1000)+COUNTA('Tier 5'!C2:C1000)
If x = 0 then
msgbox " No impact "
End If
End sub
The code is suppose to count and add the rows in coloumn C with values, in the the 4 sheets and if it equals zero then show the message box.
One way to do this is using the Evaluate function:
Sub To_open()
Dim n As Long
n = Evaluate("COUNTA('Tier 2'!C2:C1000) + " & _
"COUNTA('Tier 3'!C2:C1000) + " & _
"COUNTA('Tier 4'!C2:C1000) + " & _
"COUNTA('Tier 5'!C2:C1000)")
MsgBox n
End Sub
Try
x =Application.WorksheetFunction.COUNTA('Tier 2'!C2:C1000)+COUNTA('Tier 3'!C2:C1000)+COUNTA('Tier 4'!C2:C1000)+COUNTA('Tier 5'!C2:C1000))
Related
I have written a code which gives me exact count of empty/blank cells in a column/s.
This shows the results if I run the code for column A
Sub countblank()
Const column_to_test = 2 'column (B)
Dim r As Range
Set r = Range(Cells(2, column_to_test), Cells(Rows.Count,
column_to_test).End(xlUp))
MsgBox ("There are " & r.SpecialCells(xlCellTypeBlanks).Count & " Rows
with blank cells in column B")
Const columns_to_test = 3 'column (C)
Set r = Range(Cells(3, columns_to_test), Cells(Rows.Count,
columns_to_test).End(xlUp))
MsgBox ("There are " & r.SpecialCells(xlCellTypeBlanks).Count & " Rows
with blank cells in column c ")
'and so on i can count the blanks for as many columns i want
End Sub
But the problems are as follows:-
If there are no blanks, this macro will throw an error and will terminate itself. What if I want to run the remaining code?
Using array or something equivalent I want to search the multiple columns by header at the same time, instead of column number that to separately as shown in the code.
If a blank/s is found it pops a Msgbox but can we get the list of error in a separate new sheet called "error_sheet"?
Function getBlanksInListCount(ws As Worksheet, Optional FirstRow = 2, Optional TestColumn = 2)
With ws
getBlanksInListCount = WorksheetFunction.countblank(.Range(.Cells(FirstRow, TestColumn), .Cells(.Rows.Count, TestColumn).End(xlUp)))
End With
End Function
Try this
Sub countblank()
Dim i As Long
For i = 2 To 10 ' for looping through the columns
Dim r As Range
Set r = Range(Cells(2, i), Cells(Rows.Count, i).End(xlUp))
'for not getting error and adding error messages in the error_sheet
'MsgBox ("There are " & Application.WorksheetFunction.countblank(r) & " Rows with blank cells in column" & r.Column)
Sheets("error_sheet").Range(r.Address).Value = "There are " & Application.WorksheetFunction.countblank(r) & " Rows with blank cells in column" & r.Column
Next i
End Sub
Try sub MAIN to examine the first three columns:
Sub countblank(column_to_test As Long)
Dim r As Range, rr As Range, col As String
col = Split(Cells(1, column_to_test).Address, "$")(1)
Set r = Range(Cells(2, column_to_test), Cells(Rows.Count, column_to_test).End(xlUp))
On Error Resume Next
Set rr = r.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If rr Is Nothing Then
MsgBox ("There are no Rows with blank cells in column " & col)
Else
MsgBox ("There are " & r.SpecialCells(xlCellTypeBlanks).Count & " Rows with blank cells in column " & col)
End If
End Sub
Sub MAIN()
Dim i As Long
For i = 1 To 3
Call countblank(i)
Next i
End Sub
Q1 can be answered by using an error handling statement. Error handling statements can be as simple or complicated as one would like them to be. The one below is probably my first go to method.
' if no blank cells found, code continues
On Error Resume Next
MsgBox ("There are " & r.SpecialCells(xlCellTypeBlanks).Count & _
" Rows with blank cells in column B")
Using headers would work fine. Please see final answer below for this method.
This answer is a minor change from the answer submitted by Imran Malek
Sub countblank()
Dim i As Long
' new integer "row" declared
Dim row As Integer
' new integer "row" set
row = 1
For i = 2 To 4 ' for looping through the columns
Dim r As Range
Set r = Range(Cells(2, i), Cells(Rows.Count, i).End(xlUp))
'for not getting error and adding error messages in the error_sheet
'MsgBox ("There are " & Application.WorksheetFunction.countblank(r) & " Rows with blank cells in column" & r.Column)
' using the value in row to insert our output
Sheets("error_sheet").Range("A" & row).Value = "There are " & Application.WorksheetFunction.countblank(r) & " Rows with blank cells in column" & r.Column
' adding 1 to "row" to prep for next output
row = row + 1
Next i
End Sub
Final answer: My apologies for the lengthy answer. This answer is a modification of Imran Malek's answer, found in the link of answer 3. Please note, this version does not contain error handling, explained in Q1.
Sub countblank()
Dim Header(1 To 4) As String
Header(1) = "Name"
Header(2) = "Age"
Header(3) = "Salary"
Header(4) = "Test"
Dim i As Integer
Dim row As Integer
Dim r As Range
Dim c As Integer
row = 1
' **NOTE** if you add any more values to {Header}, the loop has to be equal to the Header count
' i.e. 4 {Headers}, 4 in the loop
For i = 1 To 4
'looking for the header in row 1
c = Cells(1, 1).EntireRow.Find(What:=Header(i), LookIn:=xlValues).Column
'defining the column after header is found
Set r = Range(Cells(2, c), Cells(Rows.Count, c).End(xlUp))
' using the value in row to insert our output
Sheets("error_sheet").Range("A" & row).Value = "There are " & Application.WorksheetFunction.countblank(r) & " Rows with blank cells in column" & r.Column
' adding 1 to "row" to prep for next output
row = row + 1
Next i
End Sub
I am trying to pass the line column value to the sub that will call a function to calculate some logic.
Before writing a sub I just defined a function and passed values manually to the function and dragging to the columns I needed.
But now I wanted to create something that will auto apply formula to a range of the column.
This is the code I am trying to do, maybe its not the best way but open for suggestions.
Function addDiscount(Qty, Price)
'
' addDiscount Macro
' adds Discount to given price and quantity
'
' Keyboard Shortcut: Ctrl+h
If (Qty >= 10 Or Price >= 200) Then
addDiscount = 30 * 0.01
Else
addDiscount = 0
End If
addDiscount = Application.Round(addDiscount, 2)
End Function
Sub insertAddDiscount()
Sheets("Sheet1").Select
Range("F9:F30").Select
Dim i As Integer
For i = 9 To 30
Selection.Formula = "=addDIscount($G$i,$E$i)"
Selection.Columns.AutoFit
Next i
End Sub
Since you are using a variable i inside the formula, you need to take it outside the ".
replace your line:
Selection.Formula = "=addDIscount($G$i,$E$i)"
with:
Selection.Formula = "=addDIscount($G" & i & ",$E" & i & ")"
However, let me suggest a solution, where you don't need to rely on Selecting the Range, and later on use Selection, but rely on fully qualified Range object (this will also shorten your code's run-time).
Sub insertAddDiscount()
Dim i As Long
With Sheets("Sheet1")
For i = 9 To 30
.Range("F" & i).Formula = "=addDIscount($G" & i & ",$E" & i & ")"
Next i
.Range("F9:F30").Columns.AutoFit
End With
End Sub
I need to get ranges from pre-set columns and a row from a variable. If i try to get this range by hand everything works. How do i get the same range using the variable?
How do i get from:
Dim j As Integer
j = 20
MsgBox Union(Sheets("Temp").Range("H10:H20"), _
Sheets("Temp").Range("K10:K20")).Address
... to something like this: (only that it works?)
MsgBox Union(Sheets("Temp").Range("H10:H" & j ), _
Sheets("Temp").Range("K10:K" & j)).Address
Here you go:
Option Explicit
Public Sub TestMe()
Dim j As Long
j = 20
MsgBox Union(Sheets(1).Range("H10:H" & j), _
Sheets(1).Range("K10:K" & j)).Address
End Sub
Result:
I think what you're asking is how you change j (20) into a dynamic variable? if so, something like this will do it:
Option Explicit
Public Sub TestMe()
Dim j As Long
j = Range("H10").End(xlDown).Row
MsgBox Union(Sheets(1).Range("H10:H" & j), _
Sheets(1).Range("K10:K" & j)).Address
End Sub
Please note: it there's an empty cell in the H column then j will be the row immediately above it - a work-around this would be j = Range("H" & Columns("H:H").Rows.Count).End(xlUp).Row
I'm trying to extract the numerator and denominator of a range of cells using VBA.
So for example, in cell A1 the formula is: =NV2/NV3. NV2 and NV3 are named values and are for example NV2 = 3 and NV3=6. In text, the result of the formula in A1 would be 0.5.
What would be the approach to retrieve NV2 and NV3? I need to somehow make reference to the formula I believe.
Many thanks for your help.
Select the cells you wish to examine and run:
Sub marine()
Dim r As Range
For Each r In Selection
v = r.Formula
If r.HasFormula And InStr(v, "/") > 0 Then
ary = Split(Mid(v, 2), "/")
msg = r.Address & vbCrLf & v & vbCrLf & ary(0) & vbCrLf & ary(1)
MsgBox msg
End If
Next r
End Sub
I'm pretty new to VBA and was wondering why my formula doesnt work?
I'm trying to loop the cells Sheets("Summary").Cells(11 + X, 13) in my match function but it doesn't seem to work. Am I doing something wrong?
Sub Reset()
Dim X As Integer
For X = 0 To 19
Sheets("Summary").Cells(11 + X, 13).Select
Selection.Formula = "=INDEX(YMAX!$A:$W,MATCH(Summary!$J$4&"" ""&Summary!$J$5&"" ""&11,YMAX!$B:$B,0),MATCH(sheets("Summary").cells(11 + x,9),YMAX!$1:$1,0))"
Next X
End Sub
It looks like you have the following errors
&'s are in the wrong places (should be outside of the quotes when concatenating text, inside the quotes when concatenating cell references)
Variables (i.e. your reference to a cell on the "Summary" sheet) do
not need to be in quotes when building a string in VBA
(not an error, per say) You don't need to do .Select as you can
set the formula of the cell directly.
Update your code with the following
Sub Reset()
Dim X As Integer
For X = 0 To 19
' Broken up on several lines for clarity
Sheets("Summary").Cells(11 + X, 13).Formula =
"=INDEX(YMAX!$A:$W,MATCH(Summary!$J$4" & " " & _
"Summary!$J$5" & " " & _
"11,YMAX!$B:$B,0),MATCH(" & _
Sheets("Summary").Cells(11 + X,9).Address & _
",YMAX!$1:$1,0))"
Next X
End Sub
I'm not sure if that's the formula you want exactly, but it's what i interpreted given your current code. Let me know if that works for you.