Counting Visible Blank cells in a row - excel

I have a data set with a large number of blank fields in each column. I would like to count the number of blank cells in each column after I've applied some arbitrary filters to other column(s).
I've gotten this to work in a sub with the following
Sub whatever()
Dim myrange As Range
Set myrange = Worksheets("Sheet1").Range("a1:a100")
myrange.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeBlanks).Count
End Sub
But when I try to put it in a UDF like so
Function CountBlankVisible(myrange As Range)
CountBlankVisible = myrange.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeBlanks).Count
End Function
It seems to be counting every cell in the range regardless of cell type. Any ideas why this would work in a sub but not as a function? is it possible to get this count some other way?

Excel UDF has some limitations (when called from worksheet). You can read about them here.
Here is working example:
Function CountBlankVisible(myrange As Range)
Dim c As Range
For Each c In myrange
If c.RowHeight > 0 And IsEmpty(c.Value) Then _
CountBlankVisible = CountBlankVisible + 1
Next
End Function

As an alternative to simoco's code:
Function CountBlankVisible(myrange As Range)
Dim c As Range
For Each c In myrange
If Not c.EntireRow.Hidden And c.Value ="" Then
CountBlankVisible = CountBlankVisible + 1
End If
Next
End Function

Related

Efficient formula or code to determine number of errors in range VBA

I am attempting to retrieve the number (count) of "#N/A" and "#Value" cells within a range (EG A1:A100).
So far I have 2 solutions:
Array formula : "=COUNT(IF(ISERROR(A1:A100), 1, 0))" cntr + shft + entr
the solution works but lags a dynamic element. If it does update, it is slow and late to the party.
Create a custom formula (nested in a module)
Public Function ErrorArray(Rng As Range)
Dim ErrorCount As Integer
Dim Cell As Range
Application.Volatile
For Each Cell in Rng
If Cell.Errors.Items(xlEvaluateToError) = True Then
ErrorCount = ErrorCount + 1
End If
Next Cell
ErrorArray = ErrorCount
End Function
*Please excuse any errors, it did work so thats not the point.
The issue with this solution is the massive drop in workbook performance. Does anyone else know an efficient and dynamic solution, either formula or code?
You could use:
=SUM(COUNTIF(A1:A100,{"#N/A","#VALUE!"}))
Also you can use for any error:
=SUM(--ISERROR(A1:A100))
Enter as array formula
NOTE: *The following function will work if called from a vba Macro (Sub). The .SpecialCells method doesn't seem to work when called from a worksheet via a UDF`
Public Function ErrorArray(Rng As Range) As Long
Dim c As Range
Set c = Rng.SpecialCells(xlCellTypeFormulas, xlErrors)
If Not c Is Nothing Then
ErrorArray = c.Count
Else
ErrorArray = 0
End If
End Function
If you just want to count only the #N/A and #VALUE! errors:
Public Function ErrorArray(Rng As Range) As Long
Dim r As Range, c As Range
Dim errCount As Long
Set r = Rng.SpecialCells(xlCellTypeFormulas, xlErrors)
If Not r Is Nothing Then
For Each c In r
'Debug.Print c.Text, c
Select Case c
Case CVErr(2042), CVErr(2015)
errCount = errCount + 1
End Select
Next c
Else
errCount = 0
End If
ErrorArray = errCount
End Function
If you have very large numbers of errors, the above code can be sped up by using variant arrays. Let me know.
Error Cells Count
Copy the code into a standard module, e.g. Module1.
In Excel use it like this: =ErrorCellsCount(A1:A100)
The Code
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Counts the number of cells containing an error value.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function ErrorCellsCount(CheckRange As Range) As Long
If Not CheckRange Is Nothing Then
If CheckRange.Rows.Count > 1 Or CheckRange.Columns.Count > 1 Then
' Check Range contains multiple cells.
Dim Data As Variant
Data = CheckRange.Value
Dim Element As Variant
For Each Element In Data
If IsError(Element) Then
ErrorCellsCount = ErrorCellsCount + 1
End If
Next Element
Else
' Check Range contains one cell only.
If IsError(CheckRange) Then
ErrorCellsCount = 1
End If
End If
End If
End Function

Grab first cell of data in row by column

Excel Data
The image is for the excel data I am playing around with. I will attach my code later. But I am trying to fill Column H with the first found cell of each row from Column A-E. Ex. for row 1 it should find "B" and place that to H, row 2 should have "c" place that to "H", and so on row 3 "is" to H, row 4 "a" to H.
I cannot for the life of me figure this out. VBA has never been my strongest suit and I have been playing around with this for 2 days now. Here is my code.
Function findValue() As String
Dim rng As Range
Dim row As Range
Dim cell As Range
Dim val As String
' Sets range of 5 columns to search in by column
Set rng = Range("A:E")
' searches through count of rows
For i = 2 To Range("A" & Rows.Count).End(xlUp).row
For Each cell In rng.Cells(i)
If IsEmpty(cell) = True Then
MsgBox cell
MsgBox i
Else
'MsgBox Range.(cell & i).Value
findValue = cell
Set rng = Range("A:E")
Exit For
End If
Next cell
Next i
End Function
Any Help is greatly appreciated.
The formula is:
=INDEX(A1:E1,AGGREGATE(15,6,COLUMN(A1:E1)/(A1:E1<>""),1))
If this is intended as a UDF, I believe that the following code is what you are after:
Function findValue() As String
Application.Volatile = True
Dim r As Long
Dim c As Long
r = Application.Caller.Row
For c = 1 To 5
If Not IsEmpty(Cells(r, c)) Then
findValue = Cells(r, c).Value
Exit Function
End If
Next
findValue = ""
End Function
An alternative method, where you pass the range to be checked rather than just checking the current row, would be:
Function findValue(rng As Range) As String
Dim c As Range
For Each c In rng
If Not IsEmpty(c) Then
findValue = c.Value
Exit Function
End If
Next
findValue = ""
End Function
This could then be used in cell H2 as =findvalue(A2:E2), and has the advantage that it does not need to be marked Volatile. ("Volatile" functions have to be recalculated every time anything at all changes on the worksheet.)
P.S. I strongly suggest that you use an Excel formula instead (such as the one in Scott's answer) - why reinvent the wheel when Excel already provides the functionality?
I'm not by my PC so can't test it, but you could try this
Sub FindValue()
Dim myRow As Range
' Sets Range of 5 columns to search in by column
Set rng = Intersect(Range("A:E"),ActiveSheet.UsedRange)
' searches through count of rows
For each myRow in rng.Rows
Cells(myRow.Row, "H").Value = myRow.Cells.SpecialCells(xlCellTypeConstants).Cells(1)
Next
End Sub

vba Loop thru rows in range return column value

At wits end here. Just trying to return the value of specific column(4) while looping thru rows in range. Here's what I have so far.
With sht
'Iterate over rows in used range
For Each loopRow In workRange.Rows:
myVariable = .Cells(loopRow, 4).Value
MsgBox myVariable
Next loopRow
End With
It's not clear exactly what you're trying to do, but here's how I normally prefer to traverse rows and columns in Excel with VBA, with row and column offset counter variables. This sample will print the cells in column D to the immediate window.
Given this:
This code identifies the values of interest:
Public Sub GetCol4()
Dim Rng As Excel.Range, rowOffset As Long
Set Rng = ThisWorkbook.Worksheets("Sheet1").Range("A1")
Do Until IsEmpty(Rng.Offset(rowOffset, 0).Value)
Debug.Print Rng.Offset(rowOffset, 3).Value
rowOffset = rowOffset + 1
Loop
End Sub
...and results in this being left in the Immediate Window:

Autogenerate Serial Number with Rows Automatically Sorted According to Priority Column

I require a macro to autogenerate a serial number on Column A as soon as information is entered in column B. Column C allows for prioritisation of the information in column B. I currently have a macro that sorts the rows according to prioritisation. Thus priorities 1 would be sorted at top of the sheet, followed by 2 etc.
Thus the question how to autogenerate a serial number taking in consideration that the sort macro will move the rows around according to assigned priority.
Serial number should be a simple numeric sequence starting at 1,2,3.....
Not sure how query for the last number used in order to create next number.
I imagine it will be some variation of =MAX(A:A)+1
If you are using Excel 2003 you may want to restrict the range to say =MAX(A1:A65536)+1
and in VBA
Option Explicit
Sub test()
Dim lookuprng As Range
Dim nextSerial As Long
Set lookuprng = Sheet1.Range("A:A")
nextSerial = WorksheetFunction.Max(lookuprng) + 1
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range
Set rng = Application.Intersect(Target, Me.Columns(2))
If Not rng Is Nothing Then
'protect against processing (eg) the insertion of a whole column
If rng.Cells.Count < 100 Then
For Each c In rng.Cells
If Len(c.Value) > 0 And Len(c.Offset(0, -1).Value) = 0 Then
c.Offset(0, -1).Value = GetNextNumber()
End If
Next c
End If
End If
End Sub
Function GetNextNumber()
Dim rv
With Me.Range("H1")
rv = .Value
.Value = .Value + 1
End With
GetNextNumber = rv
End Function

Excel / VB - How do I loop through each row/column and do formatting based on the value?

Here's what I need to do:
1) Loop through every cell in a worksheet
2) Make formatting changes (bold, etc) to fields relative to each field based on the value
What I mean is that if a field has a value of "foo", I want to make the field that is (-1, -3) from it bold, etc. I tried to do this with the following script with no luck.
Thanks
Johnny
Pseudo Code to Explain:
For Each Cell in WorkSheet
If Value of Cell is 'Subtotal'
Make the cell 2 cells to the left and 1 cell up from here bold and underlined
End If
End ForEach
The Failed Macro (I don't really know VB at all):
Sub Macro2()
'
'
'
Dim rnArea As Range
Dim rnCell As Range
Set rnArea = Range("J1:J2000")
For Each rnCell In rnArea
With rnCell
If Not IsError(rnCell.Value) Then
Select Case .Value
Case "000 Total"
ActiveCell.Offset(-1, -3).Select
ActiveCell.Font.Underline = XlUnderlineStyle.xlUnderlineStyleSingleAccounting
End Select
End If
End With
Next
End Sub
Option Explicit
Private Sub macro2()
Dim rnArea As Range
Dim rnCell As Range
' you might need to change the range to the cells/column you want to format e. g. "G1:G2000" '
Set rnArea = Range("J1:J2000")
For Each rnCell In rnArea
With rnCell
If isBold(.Offset(1, 3).Value) Then
.Font.Bold = True
End If
If isUnderlined(.Offset(1, 3).Value) Then
'maybe you want this: .Font.Underline = xlUnderlineStyleSingle '
.Font.Underline = xlUnderlineStyleSingleAccounting
End If
End With
Next
End Sub
Private Function isBold(cellValue As Variant) As Boolean
Dim myList() As Variant
Dim listCount As Integer
Dim i As Integer
myList = Array("Totals", "FooTotal", "SpamTotal")
listCount = 3
isBold = False
For i = 0 To listCount - 1
If cellValue = myList(i) Then
isBold = True
Exit Function
End If
Next i
End Function
Private Function isUnderlined(cellValue As Variant) As Boolean
Dim myList() As Variant
Dim listCount As Integer
Dim i As Integer
myList = Array("FooTotal", "SpamTotal")
listCount = 2
isUnderlined = False
For i = 0 To listCount - 1
If cellValue = myList(i) Then
isUnderlined = True
Exit Function
End If
Next i
End Function
I added two functions but it should have also worked with an extensive if / else if / else.
Based on the comments on the solution above, i think this might be helpful
Sub FormatSpecialCells()
Dim SearchRange As Range
Dim CriteriaRange As Range
Set SearchRange = Range("A2:A24")
Set CriteriaRange = Range("C2:C5")
Dim Cell As Range
For Each Cell In SearchRange
TryMatchValue Cell, CriteriaRange
Next
End Sub
Private Sub TryMatchValue(CellToTest As Range, CellsToSearch As Range)
Dim Cell As Range
For Each Cell In CellsToSearch
If Cell.Value = CellToTest.Value Then
Cell.Copy
CellToTest.PasteSpecial xlPasteFormats, xlPasteSpecialOperationNone, False, False
End If
Next
End Sub
This does not fully accomplish your goal. What it does is it searches a specified list of cells, and it matches them against a seperate list of cells. If it matches the values, it takes the FORMAT of the second list of cells and applies it to the cell it matched in the first list of cells. You can modify this by changing the TryMatchValue function so that instead of matching the CellToTest, it pastes the format onto another cell which is 2 across and one up.
This has the advantage that, if you want to add more values and different formats, you only need to go to your excel sheet and add more values. Also you only need to change the format on that value.
An example would be...
Have the cells you are searching in A1:D1000
Have these values in cells E2:E6...
Subtotal (which is bold and underlined)
Total (which is bold, underlined and italic)
Net (which is bold underlined and Red)
etc...
then when it hits Subtotal, it will change the cell to be bold and underlined.
When it hits Total it will change the cell to be bold underlined and italic
etc etc...
hope this helps
Would the conditional formatting functionality in excel give you what you need without having to write a macro?

Resources