Select CASE / CASE over range of cells - vba

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.

Related

VBA loop through range and output if complete range is empty

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 :-)

Loop through Cols & Rows with IF statement vba

All,
I have written the below code to check if cells in the variable range have conditional formatting. However the code falls over at "If Cells.ColorIndex = 3 Then" can anyone suggest why the error is occurring and if there is a better solution than the below code to achieve a loop through cols & rows (variable length)
Sub Check_Conditional()
Dim rng As Range
Dim row As Range
Dim cell As Range
Dim RW As Long
RW = ActiveSheet.Range("Total").Offset(rowOffset:=-1).row
Set rng = Range("O7:AB" & RW)
For Each row In rng.Rows
For Each cell In row.Cells
If Cells.ColorIndex = 3 Then
MsgBox "Not all the cells have been filled out"
Exit For
End If
Next cell
Next row
End Sub
cell.ColorIndex is not a valid Range property.
If you mean to check the font's color then use If cell.Font.ColorIndex = 3 Then
If you mean to check the Fill color, then use If cell.Interior.ColorIndex = 3 Then
When you type in the editor, Cell. the VBA autocompletes it with the following options:
There's no cell.ColorIndex in the list:

How to find the last cell in a column which is supposed to be blank but has spaces?

So I have data with around 20,000 records. I want to set the range such that only data from Row 2 to 20,000 is checked in column A. However, cell 20,001 isn't blank, it could contain spaces as well.
(This data is imported prior to validation, so I cannot alter it)
When I use .End(xlUp) it ends up checking till some 50,000th row.
Any Help?
Sample:
Column A
A
B
(2 spaces inserted)
I want to check for cells only till B(including it)
Update:
Managed to return the last required cell to the main sub
Private Sub last()
Dim rngX As Range
Set rngX = ActiveSheet.Range("A1").EntireColumn.Find(" ", lookat:=xlPart)
If Not rngX Is Nothing Then
/* return value
End If
End Sub
GD pnuts,
If you want to use VBA, you could contemplate checking for [space] character ? assuming the cell contains only spaces (or only one for that matter)
Something like:
Dim r as range
set r = range("B")
For each c in r.rows
if instr(1, c.value,chr(32)) > 0 then
'do something
end if
next
You could function a check of all characters in cell.value string to validate that they are only spaces ?
Does that help ?
I believe you will have to test each cell individually. To make the number of cells to check smaller, and to speed things up, I would first read the column to check into a Variant array, and then check that from bottom to top. I the spaces are truly a space, the test below will work. If the space is a NBSP, or a combination, then you will have to revise the check to ensure that is the only thing present.
e.g: to check column A:
Option Explicit
Sub foo()
Dim R As Range
Dim WS As Worksheet
Dim V As Variant
Dim I As Long
Set WS = Worksheets("sheet2")
With WS
V = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
For I = UBound(V) To LBound(V) Step -1
'Revise this check line as needed
If Len(Trim(V(I, 1))) > 0 Then Exit For
Next I
Set R = .Cells(I, 1)
End With
Debug.Print R.Address
End Sub
You might want to add some error checking in case all of the cells are empty.

Find If cell matches in another sheet and count/sum instances

I have been using simple excel array formulas to count certain values on a master sheet but now at the point where I have too many formulas in my document and excel is crashing.
Therefore, I would like to create a macro that can do the same task. I would like to have the code do the following:
IF the activecell in Sheet1 matches to any cell in a column(or range) in Sheet2,
AND IF the cell in the same row in an adjacent column in Sheet2 is not blank,
THEN count all the instances that specific string appears in Sheet2 column A
AND place the value 2 columns to the right of the original active cell in Sheet1.
Here is the original array formula I was using:
=SUM(IF(Sheet1!$A8=Sheet2!$A:$A,IF(SalesF_SignUp_data!$C:$C>1,1,0)))
The formula above is taking the cell A8 in Sheet1 and checking if it matches to any cell in Sheet2 column A,
AND making sure that column C in Sheet2 is not blank in the same row.
If this is TRUE then "add 1" for all the instances
AND place that value in Sheet1.
I believe the best way to do this is a For Next Loop but haven't been able to execute any successful code based on examples I've found.
Im happy to explain further if needed. Since I dont have a reputation of 10 I cant attach images but am willing to send if needed.
This is set up to run for all the cells you've selected in column A of sheet 1.
It looks in Sheet2 column A for the value on Sheet1 column A, then in Sheet1 column B, displays how many times the value appeared in Sheet2 column A along with a value in the same row of column C.
If the answer is helpful, please mark it as such. :-)
Option Explicit
Sub countinstances()
Dim result, counter, loopcount, tocomplete, completed As Integer
Dim findtext As Variant
Dim cell, foundcell, nextcell As Range
'Checks to make sure the sub isn't accidentally run on an invalid range
If ActiveSheet.Name <> "Sheet1" Or ActiveCell.Column <> 1 Or Selection.Columns.Count > 1 Then
MsgBox ("Please select a range in column A of Sheet 1.")
Exit Sub
End If
'In case of selecting the entire column A, curtail the number of blank cells it runs on.
tocomplete = Application.WorksheetFunction.CountA(Selection)
completed = 0
'For each cell in the selected range, searches Sheet2, Column A for the value in the selected cell
For Each cell In Selection
If completed = tocomplete Then Exit Sub
If cell.Value <> "" Then completed = completed + 1
findtext = cell.Value
result = 0
Set foundcell = Sheets("Sheet2").Range("A1")
'Uses the count function to determine how many instances of the target value to search for and check
loopcount = Application.WorksheetFunction.CountIf(Sheets("Sheet2").Range("A:A"), findtext)
'Skips the loop if the target value doesn't exist in column A
If loopcount = 0 Then GoTo NotFound
'For each time the target value was found, check the cell in column C. If it's not blank, increment "result"
For counter = 1 To loopcount
Set nextcell = Sheets("Sheet2").Range("A:A").Find(what:=findtext, lookat:=xlWhole, after:=foundcell)
If nextcell.Offset(0, 2).Value <> "" Then
result = result + 1
End If
Set foundcell = nextcell
Next
'Put the result in column B of Sheet1
NotFound:
cell.Offset(0, 1).Value = result
Blanks:
Next
End Sub

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