VBA loop through range and output if complete range is empty - vba

I have searched a lot about my question but could not find the answer I need.
I have a table A1:DT97138. Within this table I want to check per row, starting from cell B2 to DT2 if all the cells in one row are empty. Then output "Empty" or "Not Empty" in the next cell, DU2. Then do the same for row 3, 4 etc to 97138 (and output the same results row per row in DU2, DU3 etc).
I found out how to do this for 1 specific row, as you can see below, but I cannot find out how to iterate trough the whole range, row by row.
Sub rowEmpty()
Dim rng As Range, r As Range
Set rng = Range("B2:DT97138")
If WorksheetFunction.CountA(Range("B2:DT2")) = 0 Then
Cells(2, 125) = "Empty"
Else
Cells(2, 125) = "Not Empty"
End If
End Sub
Thanks for your help!

Your are doing well. Just need to loop thru the range like this.
Sub rowEmpty()
Dim rng As Range, r As Range
Set rng = Range("B2:DT97138")
For Each r In rng.Rows
If WorksheetFunction.CountA(r) = 0 Then
Cells(r.Row, 125) = "Empty"
Else
Cells(r.Row, 125) = "Not Empty"
End If
Next r
End Sub

Enter your formula at once in the last column:
With Range("DU2:DU97138")
.Formula = "=IF(COUNTA(B2:DT2)=0,""Empty"",""Not Empty"")"
'then eventually convert it to constants
.Value = .Value
End With
No loops, simpler, probably much faster :-)

Related

Filtering depending upon the column values

I have a sheet FC, with this sheet, I have column R, S and T filled.
I would prefer to have a code, which checks if R contains "invalid" and if S and t are filled, then it should filter complete row.
I know we can use isblank function to check whether the cell is blank or not,
but I am struck how I can use a filter function with these condition .Any help will be helpful for me. I am struck how I can proceed with a vba code. Apologize me for not having a code.
You will have to somehow specify last row:
Dim lastRow, i As Long
For i = 1 To lastRow 'specify lastRow variable
If InStr(1, LCase(Range("R" & i).Value), "invalid") > 0 And Range("S" & i).Value = "" And Range("T" & i).Value = "" Then
'do work
End If
Next i
In our If condition we check three things that you asked.
Try this
Sub Demo()
Dim lastRow As Long
Dim cel As Range
With Worksheets("Sheet3") 'change Sheet3 to your data sheet
lastRow = .Cells(.Rows.Count, "R").End(xlUp).Row 'get last row in Column R
For Each cel In .Range("R5:R" & lastRow) 'loop through each cell in range R5 to lase cell in Column R
If cel.Value = "invalid" And Not IsEmpty(cel.Offset(0, 1)) And Not IsEmpty(cel.Offset(0, 2)) Then
cel.EntireRow.Hidden = True 'hide row if condition is satisfied
End If
Next cel
End With
End Sub
EDIT :
To unhide rows.
Sub UnhideRows()
Worksheets("Sheet3").Rows.Hidden = False
End Sub
Assuming Row1 is the header row and your data starts from Row2, in a helper column, place the formula given below.
This formula will return either True or False, then you may filter the helper column with either True or False as per your requirement.
=AND(R2="Invalid",S2<>"",T2<>"")
In case your header row is different, tweak the formula accordingly.
sub myfiltering()
'maybe first row always 4
firstrow=4
'last, maybe R column alaways have any entered info, so let us see what is the last
lastrow=cells(65000,18).end(xlup).row
'go ahead
for myrow=firstrow to lastrow
if cells(myrow,18)="Invalid" and cells(myrow,19)="" and cells(myrow,20)="" then
Rows(myrow).EntireRow.Hidden = True
else
Rows(myrow).EntireRow.Hidden = false
end if
next myrow
msgbox "Filter completed"
end sub
hope this will help you :)
Why you need the vba code for this problem?
Its more simple if you add a new column with if & and formula, and autofiltering within the added col.
The formula may be similar like this in the U2 cell.
=if(and(R2="invalid";S2="";T2="");"x";"")
Also set autofilter to x. :)

Conditional formatting range based on 2 conditions (other cell's format/ value)

I'm new to VBA and English isn't my native language so here goes.
I want to conditional format rows/ range (giving them green-colored background) if cell C in that row have duplicate value in column C and also if there's a cell in column O that equals 0, but if the cell in column C has no similar value, don't apply the conditional format to that cell (eventhough cells in column O has the value of 0).
Note: Cells that have same values in column C will always be above and below each other, for example it's possible that C1=C2=C3 but not C1<>C2, C1=C3
I know I'm not explaining it clearly, so please just let me know if you want more information.
Update (more information): I may have 3 or more rows with same C column value above and below each other, and the zero value in column O will always be the bottom row.
Example:
If C1=C2=C3=C4=C5 and O5=0 , Rows 1 2 3 4 5 become green colored.
I prefer using conditional format even if it needs vba code so I dont have to run it everytime there's new 0 in column O.
I've used this code but it doesn't work (obviously), but maybe it's a little different with my question because the real data is more complicated than what I illustrated. My data table starts at 4th row (header on 3rd). This code only formats 1 row (above the row that has zero column O value) and what I need is all rows with same column C value are formatted. Please keep in mind that I'm a newbie in vba :(
With Range("A4:r8000").FormatConditions.Add( _
Type:=xlExpression, _
Formula1:="=AND($C4=$C5,$O5=0,$F4<>0)")
.Interior.Color = 13551615
.Font.Color = -16383844
End With
Try this as the formula for the CFR,
=and(countif(c:c, c1)>1, o1=0, len(o1))
'alternate for part that I am not sure I understand
=and(countif(c$1:c1, c1)>1, o1=0, len(o1))
This will go through and highlight duplicate cells if any of the duplicate cells' rows have '0' in column O. I am still working on a way that will make this auto update whenever a change happens in Column O, but can't quite figure that out. Will update when I do.
Sub ConditionalFormatSE()
Application.ScreenUpdating = False
Dim lastRow As Long
Dim myCell As Range
Dim colCVals As Range
lastRow = Cells(Rows.Count, 3).End(xlUp).Row
Set colCVals = Range("C1", "C" & lastRow)
colCVals.clearformats
For Each myCell In colCVals
If Cells(myCell.Row, 15).Value = "0" Then
If WorksheetFunction.CountIf(colCVals, myCell.Value) > 1 Then
Set c = colCVals.Find(myCell.Value)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.color = RGB(198, 239, 206)
c.Font.color = RGB(0, 97, 0)
Set c = colCVals.FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End If
End If
Next myCell
Set colCVals = Nothing
Set myCell = Nothing
Set c = Nothing
Application.ScreenUpdating = True
End Sub
As for making it run automatically, put this in: VBAProject([workbookname].xlsm)->Microsoft Excel Objects->Sheet1([sheetname]) and it should run whenever a value in column 'O' is changed
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Columns(15)
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
Call ConditionalFormatSE
End If
Set KeyCells = Nothing
End Sub
If cells with same values are always grouped (one below the other), following code might do what you want.
Sub Test()
Dim lLastRow As Long
Dim i As Integer
lLastRow = Worksheets("Sheet1").Cells(Rows.Count, 3).End(xlUp).Row
For i = 1 To lLastRow
If ((Worksheets("Sheet1").Cells(i + 1, 3).Value = Worksheets("Sheet1").Cells(i, 3).Value) And (Worksheets("Sheet1").Cells(i, 15).Value = "0")) Then
Worksheets("Sheet1").Cells(i, 3).Interior.Color = vbGreen
End If
Next i
End Sub

How to write an "If(And" code with unknown number of cells in column?

Is there a way to check if all cells in a column are less than 1? If there were only a few cells, with the number of cells known up front, I would use the code below.
However, from case to case the number of cells in column A will vary. I need to know if any of the cells in column A is less than 1.
If there is one (or more) cell containing a value less than 1, I need a cell (A1 for example) to show NOT OK. If only ALL the cells' values are greater than 1, I need the cell (A1 for example) to show OK.
If all cells in column A have values greater than 1, I want to continue and check column B for the same thing. Otherwise I want to save and close the workbook and continue with next open workbook...also with vba code.
Any suggestions on how to write this in VBA? Maybe there is way other than If(AND...)?
Sub IfAnd()
IF(AND(A5>1,A4>1,A3>1,A2>1),"OK", "NOT OK")
End Sub
This code will solve all your columns and insert the data in THE FIRST ROW OF EACH COLUMN
Sub Problems()
Dim CurCol, LastRow, LastCol as Long
LastCol = Cells(2, Columns.Count).End(xlToLeft).Column
For CurCol = 1 to LastCol
LastRow = Cells(Rows.Count, CurCol).End(xlUp).Row
If WorksheetFunction.Min(Range(Cells(2, CurCol), Cells(LastRow, CurCol))) < 1 Then
Cells(1, CurCol).Value = "NOT OK"
Else
Cells(1, CurCol).Value = "OK"
End If
Next CurCol
End Sub
Here is a way of doing it without any worksheet functions.
Sub test()
Dim ws As Worksheet
Dim ce As Range
Dim sr, lr, lc As Integer
'worksheet you are working with
Set ws = ThisWorkbook.Sheets(1)
'column you are searching
Set ce = ws.Cells(ws.Rows.Count, 1)
'start row set to 2 so row 1 will contain output
Let sr = 2
'search only the last row
Let lr = ce.End(xlUp).Row
Let lc = ws.Cells(sr, ws.Columns.Count).End(xlToLeft).Column
For c = 1 To lc
For r = sr To lr
If ws.Cells(r, c).Value < 1 Then
ws.Cells(1, c).Value = "NOT OK"
GoTo NotOK
End If
Next r
ws.Cells(1, c).Value = "OK"
NotOK:
Set ce = ws.Cells(ws.Rows.Count, c+1)
Let lr = ce.End(xlUp).Row
Next c
End Sub
This should be faster and more efficient for large data sets. Especially if it is sorted smallest to largest.
Here you are:
=IF(MAX(A:A)<1)
If VBA is not required, here is a worksheet formula that should do the job, and will also ignore blanks and non-numeric entries:
This formula must be array-entered:
=IF(ISNUMBER(MATCH(TRUE,IF(ISNUMBER($A:$A),$A:$A)<1,0)),"NOT OK","OK")
If this formula must be located in A1, change the range references from $A:$A to $A$2:$A$1000 where 1000 represents the highest conceivable row number for the data.
To array-enter a formula, after entering
the formula into the cell or formula bar, hold down
< ctrl-shift > while hitting < enter >. If you did this
correctly, Excel will place braces {...} around the formula.

Select CASE / CASE over range of cells

I have a spreadsheet with 36K lines. Each of the 36K lines will be matched to one of about 350 numbers. When that number is matched, I will have text and colons input into another column on the same row as the matching number. The questions I have are:
How can I have the macro run over a range (Example: T2:T36000) and return a value for each row?
Can I do this by column instead of the row range. (Example: Column called Category, instead of T2:T36000). The reason for this is that the number of rows in each column will be changing.
This works for one row at a time, but I don't want to have to do this for each row. I realize I will have to put values for each of the 350 different numbers.
Sub CategoryChanger()
Select Case Range("AS2").Value
Case 1492
Range("T2") = "IT DOES NOT WORKS"
Case 1491
Range("T2") = "IT WORKS"
End Select
End Sub
Thanks ahead of time.
Basic loop iteration using For Each ... Next statement:
Sub CategoryChanger()
Dim rng as Range
Dim r as Range
Dim result as String
'## Define a range to represent the cells over which you would like to iterate:
'## Modify as needed...
Set rng = Range("AS2:AS100")
'## Iterate each cell in the Range defined "rng"
For Each r in rng.Cells
Select Case r.Value
Case 1492
result = "IT DOES NOT WORKS"
Case 1491
result = "IT WORKS"
End Select
'## Print result in the cell 10 columns to right
'## Modify as needed
r.Offset(0, 10).Value = result
Next
End Sub
With 350+ values to check against 30,000 rows of data, you may be better served to index this as a table on another (hidden) worksheet and use the WorksheetFunction.VLookup to do the lookup, rather than forcing through a Case switch like this.
In that case you would omit the Select Case block altogether, and simply do like so (assuming you add a worksheet named "Lookup" and put your lookup table in range A1:B350):
Sub CategoryChanger()
Dim rng as Range
Dim r as Range
Dim result as String
'## Define a range to represent the cells over which you would like to iterate:
'## Modify as needed...
Set rng = Range("AS2:AS100")
'## Iterate each cell in the Range defined "rng"
For Each r in rng.Cells
On Error Resume Next
result = Application.WorksheetFunction.VLookup(r.Value, Worksheets("Lookup").Range("A1:B350"), 2, False)
If Err.Number <> 0 Then result = "NOT FOUND!"
On Error GoTo 0
'## Print result in the cell 10 columns to right
'## Modify as needed
rng.Offset(0, 10).Value = result
'Clear out the "result" value for the next iteration:
result = vbNullstring
Next
End Sub
I am not sure which would be optimized for this use.

How to get the value of a range within a range

So I need to extract information from a sheet with only certain values. From about 550 rows down to 50 which are spread across the entire sheet.
So I used autofilter for that. Now I only see the rows which match to my criteria but how can I get the values of a specific range from?
This far I came:
I know that I have to use
RangeINamed.SpecialCells(xlCellTypeVisible)
to work with only the visible information.
It worked for getting the starting and last row
startRow = bulkbatchRange.SpecialCells(xlCellTypeVisible).row
endRow = startRow + bulkbatchRange.SpecialCells(xlCellTypeVisible).rows.Count
But now I need to get the value of a specific column, I want to use a For loop so I can loop through all visible rows.
So I tried to do
RangeINamed.SpecialCells(xlCellTypeVisible).range("U" & rowNumber).value
That didn't work it gave me nothing. Now I'm rather clueless so does someone maybe know how I get the value of that row in column U in RangeINamed?
Thank you
You can always retrieve the value in a specific cell like U10 with:
Range("U10").Value
whether the row is hidden or not.
EDIT#1:
Here is a little example that loops down thru column A of an AutoFiltered table. It looks for the third visible row (not including the header row):
Sub GoDownFilter()
Dim rLook As Range, r As Range
Set rLook = Intersect(ActiveSheet.UsedRange, Range("A:A").Cells.SpecialCells(xlCellTypeVisible))
rLook.Select
K = 0
For Each r In rLook
If K = 3 Then
r.Select
MsgBox "The third visible row has been selected"
Exit Sub
End If
K = K + 1
Next r
End Sub
I think you need to choose if you want to get a specific cell like:
Range("U10").Value
Or a relative cell using something like
RangeINamed.SpecialCells(xlCellTypeVisible)(2,3).Value
Or
RangeINamed.SpecialCells(xlCellTypeVisible)(2,3).Address 'To see if you are getting it right
EDIT:
A complete code to Filter and Iterate.
Sub Filter()
Dim tableRange As Range, var, actualRow As Integer, lastRow As Integer
Set tableRange = Range("PUT_THE_TABLE_RANGE_HERE")
' Filter
With tableRange
Call .AutoFilter(5, "SPECIFIC_FILTER")
End With
Set f = tableRange.SpecialCells(xlCellTypeVisible)
With tableRange
Call .AutoFilter(5)
End With
For Each var In f.Cells.Rows
actualRow = var.Row
If actualRow <> 1 Then
' Do something
End If
Next
End Sub