I am trying to write a conditional case statement that searches through a specific column, in excel, for a specific string and when it matches with the string that cell's background color is changed.
If the cell is empty or does not match the string then nothing should happen to the cell.
Right now I am trying to iterate through each cell in the column and check all possible string values to compare to but it does not seem to be working .
Here is my current code:
Sub interiorsStatus()
Dim sh As Worksheet
Dim rw As Range
Set sh = ActiveSheet
For Each rw In sh.Rows
Select Case sh.Cells(rw.Row, "E").Value
Case "DELIVERED"
result = Range(rw.Row).Interior.ColorIndex = 33
Case "READY TO ORDER"
result = Range(rw.Row).Interior.ColorIndex = 36
Case "ORDERED"
result = Range(rw.Row).Interior.ColorIndex = 39
Case "DELIVERED"
result = Range(rw.Row).Interior.ColorIndex = 43
Case "EXISTING"
result = Range(rw.Row).Interior.ColorIndex = 40
Case "ON HOLD"
result = Range(rw.Row).Interior.ColorIndex = 48
Case "GENERAL CONTRACTOR"
result = Range(rw.Row).Interior.ColorIndex = 2
Case "AV & BLINDS"
result = Range(rw.Row).Interior.ColorIndex = 15
Case "MILLWORK"
result = Range(rw.Row).Interior.ColorIndex = 22
Case Else
result = """"
End Select
Exit For
Next rw
End Sub
The line Exit For stops your iteration after the first time. I think, this is not, what you want. Or you have to write it inside the case-statement.
result = Range(rw.Row).Interior.ColorIndex = 40
That's an assignment. It's assigning to result, the value of the expression to the right of the assignment operator.
Range(rw.Row).Interior.ColorIndex = 40
When you have that on the right-hand side of an assignment operator, that's a Boolean expression, it evaluates to True or False. So result will be True when ColorIndex is 40, and False otherwise.
And then nothing gets done with the result.
If you intended to actually set the ColorIndex, remove the result = assignment to turn the Boolean expression into an assignment instruction that assigns ColorIndex.
And then there's the other problem: you explicitly exit the loop just before you finish the first iteration. Remove that Exit For if you want to actually loop.
Related
In excel, I want to impose a cell to be 0 if a condition is matched, but editable if not. My condition is that another cell's value = 1. This is my minimal example VBA line:
If Range("B4").Value = 1 Then Range("C4").Value = 0
But nothing is happening even though B4 is set to 1! Is there something missing in this code? Thanks!
Qualify the Range objects with the specific worksheets you want to analyze / alter. This is best practice for VBA and ensures the code acts on the specific places you need it to.
For example:
With Worksheets("Sheet1")
If .Range("B4").Value = 1 Then .Range("C4").Value = 0
End With
Or
If Worksheets("mySheet").Range("B4").Value = 1 Then
Worksheets("yourSheet").Range("C4").Value = 0
End If
You have to refer to the sheet as well. E.g.,
If ActiveSheet.Range("B4").Value = 1 Then ActiveSheet.Range("C4").Value = 0
To see the sheet, which you were referring to, try this:
Sub TestMe()
If Range("B4").Value = 1 Then Range("C4").Value = 0
MsgBox (Range("B4").Parent.Name)
End Sub
Is it possible to use IsEmpty to refer to a cell on a different sheet from where the macro is being fired from? Also, is it possible to hide the queried column if the result of that query is True?
Here's what I've built so far:
My first version looked like this:
If IsEmpty(L1) Then
Columns("L").EntireColumn.Hidden = True
Else
Columns("L").EntireColumn.Hidden = False
End If
Straightforward enough. But, that only works if it's fired from the worksheet where I want the query/hide to occur. When I launch the macro from the different sheet, it hides the column in that sheet (of course, duh).
So, after several iterations and errors, I got to this:
If IsEmpty(Sheets("Results").Cells(10, 1).Value) Then
Worksheets("Results").Columns(10).EntireColumn.Hidden = True
Else
Worksheets("Results").Columns(10).EntireColumn.Hidden = False
End If
Which at least doesn't throw any errors from the VBA. It also does a grand total of squat. :$ I'm starting to wonder if it's even possible to use IsEmpty on a different sheet? Or the EntireColumn.Hidden command? Also, given that I need to run this check on 9 columns, maybe there's a better way than 9 If/Then statements?
To get away from a loop through 9 columns' row 1, use SpecialCells(xlCellTypeBlanks).
dim blnks as range
with workSheets("Results")
with .range(.cells(1, "B"), .cells(1, "K"))
.entirecolumn.hidden = false
set blnks = .specialcells(xlCellTypeBlanks)
if not blnks is nothing then blnks.entirecolumn.hidden = true
end with
end with
Essentially this unhides all 9 columns then hides the columns with blank cells in the first row. Note that a zero-length string (e.g. "") returned by a formula is not the same thing as a truly blank cell.
I think you're very close, just you have the cells inputs the wrong way around:
If IsEmpty(Sheets("Results").Cells(1, 10).Value) Then
Worksheets("Results").Columns(10).EntireColumn.Hidden = True
Else
Worksheets("Results").Columns(10).EntireColumn.Hidden = False
End If
Additionally as mentioned in the comments you can create a loop to check many columns:
Dim i As Integer
Dim maxi As Integer
i = 1
maxi = 20
While i < maxi
If IsEmpty(ThisWorkbook.Worksheets("Results").Cells(1, i)) Then
Worksheets("Results").Columns(i).EntireColumn.Hidden = True
Else
Worksheets("Results").Columns(i).EntireColumn.Hidden = False
End If
i = i + 1
Wend
I'm having an issue that I feel should be fairly simple but turns out I can't get it to work. I'm sure it's something that I am doing but I need your expert help. I'm simply cycling through a datatable and checking to see if a value shows up again in a different column of the datatable. For some reason BOTH statements are firing and the else statement is overwriting the If statement.
For i = 0 To length - 1
For j = 0 To length - 1
If Trim(dt.Rows(i)(0)) = Trim(dt.Rows(j)(6)) Then
need_dt.Rows(i)(9) = "COMP"
need_dt.Rows(i)(10) = Format(resource.AddWorkingDays(need_dt.Rows(i)(2), -5), "MM/dd/yy")
Else
need_dt.Rows(i)(9) = "TOP"
need_dt.Rows(i)(10) = Format(resource.AddWorkingDays(need_dt.Rows(i)(2), -16), "MM/dd/yy")
End If
If Year(need_dt.Rows(i)(10)) = 2029 Then need_dt.Rows(i)(10) = Format(resource.AddWorkingDays(Now, 14), "MM/dd/yyyy")
Next
Next
The else statement will be executed on all rows that aren't found. You need to keep the result in a variable and do the action you want at the end. Since the other If statement doesn't use j, you don't need to do it on every j.
For i = 0 To length - 1
Dim isFound As Boolean = False
For j = 0 To length - 1
If Trim(dt.Rows(i)(0)) = Trim(dt.Rows(j)(6)) Then
isFound = True
Exit For
End If
Next
If isFound Then
need_dt.Rows(i)(9) = "COMP"
need_dt.Rows(i)(10) = Format(resource.AddWorkingDays(need_dt.Rows(i)(2), -5), "MM/dd/yy")
Else
need_dt.Rows(i)(9) = "TOP"
need_dt.Rows(i)(10) = Format(resource.AddWorkingDays(need_dt.Rows(i)(2), -16), "MM/dd/yy")
End If
If Year(need_dt.Rows(i)(10)) = 2029 Then need_dt.Rows(i)(10) = Format(resource.AddWorkingDays(Now, 14), "MM/dd/yyyy")
Next
As I understand you want set column number 9 = "COMP" if value of column 0 exists in column 6 of any row.
In this case your problem is -> if last value of column 6 in last row is not equal to value of column 1 - value of column 9 will be overwritten with "TOP"
In your code you need exit from loop after you find equal value.
But I suggest to use little bid more readable approach
For Each row As DataRow in need_dt.Rows
Dim firstColumnValue As String = row.Field(Of String)("0ColumnName").Trim()
Dim is6ColumnContainValue As Func(Of DataRow, Boolean) =
Function(dtRow) dtRow.Field(Of String)("6ColumnName").Trim() = firstColumnValue
Dim isValueFound = need_dt.AsEnumerable().Any(is6ColumnContainValue)
Dim tenthColumnValue AS Date = row.Field(Of Date)("10ColumnName")
Dim workingDaysToAdd As Integer
If IsValueFound = True Then
row.SetField("9ColumnName", "COMP")
workingDaysToAdd = -5
Else
row.SetField("9ColumnName", "COMP")
workingDaysToAdd = -16
End If
If TenthColumnValue.Year = 2029 Then
tenthColumnValue = resource.AddWorkingDays(Date.Now, 14)
Else
tenthColumnValue = resource.AddWorkingDays(tenthColumnValue, workingDaysToAdd)
End If
row.SetField("10ColumnName", tenthColumnValue)
Next
Also suggest to set Option Strict On which give compile time feedback about possible type conversion errors
well my idea is to refer the alphabet in cell J9 of the first worksheet called Table1 and to automatically color the shape called "Test" on the active worksheet. So basically if the alphabet entered is "a" in the cell J9 on the first worksheet, the shape "Test" on worksheet 2 should give out color 1, and if "b", color 2 and so on. I have written a code for it but sadly I keep receiving Error 424 Object Required. Any help would be deeply appreciated! Thanks!
Sub test()
If Table1.Range("J9") = "a" Then
ActiveSheet.Shapes("Test").Fill.ForeColor.SchemeColor = 1
ElseIf Table1.Range("J9") = "b" Then
ActiveSheet.Shapes("Test").Fill.ForeColor.SchemeColor = 2
ElseIf Table1.Range("J9") = "c" Then
ActiveSheet.Shapes("Test").Fill.ForeColor.SchemeColor = 3
ElseIf Table1.Range("J9") = "d" Then
ActiveSheet.Shapes("Test").Fill.ForeColor.SchemeColor = 4
Else
ActiveSheet.Shapes("Test").Fill.ForeColor.SchemeColor = 5
Does changing all Table1 references to Worksheets("Table1") fix it? For example:
If Worksheets("Table1").Range("J9") = "a" Then
ActiveSheet.Shapes("Test").Fill.ForeColor.SchemeColor = 1
It looks like is not with the shape code but with the Table1. Tables use a special structured addressing system (see Select, get and set data in Table). If you just want the value from cell J9 then this should do.
With Sheets("Table 1")
Select Case LCase(.Range("J9").Value)
Case "a"
.Shapes("Test").Fill.ForeColor.SchemeColor = 1
Case "b"
.Shapes("Test").Fill.ForeColor.SchemeColor = 2
Case "c"
.Shapes("Test").Fill.ForeColor.SchemeColor = 3
Case Else
' do nothing
End Select
End With
If a simple reference to J9 is insufficient, you will have to provide more information on the exact nature of Table1.
EDIT:
You may not be referencing the shape's name correctly. This code will enumerate all of hte shapes on the Table 1 worksheet and return their names to the VBE's Immediate window (in the VBE as Ctrl+G).
Dim i As Long
With Sheets("Table 1")
For i = 1 To .Shapes.Count
Debug.Print .Shapes(i).Name
Next i
End With
Is Test there as one of the names? can you determine the name of the shape you want to change?
#Jeeped Is it the same if I were to use apple, orange and lemon instead of alphabets? I changed my code to make it similar like yours. This time there is no error message but nothing happens
Sub test()
With ActiveSheet
Select Case LCase(.Range("J9").Value)
Case "apple"
.Shapes("Test").Fill.ForeColor.SchemeColor = 1
Case "orange"
.Shapes("Test").Fill.ForeColor.SchemeColor = 2
Case "lemon"
.Shapes("Test").Fill.ForeColor.SchemeColor = 3
Case Else
' do nothing
End Select
End With
End Sub
Is there anything wrong in this code? and by the way, what is LCase??
Sub SO()
ActiveSheet.Shapes("Test").Fill.FillColor.SchemeColor = Asc(UCase(Sheets("Table 1").Range("J9"))) - 64
End Sub
Hope someone can help with a puzzling problem.
I have an excel worksheet that has a lot of lines that need to be moved to different sheets.
I have a select case statement that sets 3 variables to true or false depending on whether the numbers in the first column match a case statement. This works ok but I now want to add a name to an array if the value is true.
The select case statement is as follows :
While LContinue
If LRow = Lastrow Then
LContinue = False
Else
Select Case Range("A" & LRow).Value
Case 30 To 39
MainSheet = True
'Tabs(0) = "Main"
Case 40 To 49
SecondSheet = True
'Tabs(1) = "Second"
Case 111 To 112
ThirdSheet = True
'Tabs(2) = "Third"
End Select
LRow = LRow + 1
End If
Wend
This is used to see if I need to add the sheet or not. to add the sheets I use the following code :
For i = LBound(Tabs) To UBound(Tabs)
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = Tabs(i)
Next i
So what I would like to know is how would I go about adding the sheetnames to the array but only if the value in the select case is true.
Any help would be much appreciated.
Thanks
Why not use worksheet function 'CountIfs'?
It counts on multiple criteria and you do not need any loops so your code will run quicker.
CountIfs(testedRange, ">=30", testedRange, "<=39")
... calculates number of values in 'testedRange' which are >=30 and <=39. If there is at least one then just add your sheet, that's it. No loops, no arrays, no additional variables needed. HTH.
Public Sub test()
Dim testedRange As Range
Dim Lastrow As Long
Lastrow = 10
Set testedRange = ActiveSheet.Range("A1:A" & Lastrow)
With Application.WorksheetFunction
If .CountIfs(testedRange, ">=30", testedRange, "<=39") > 0 Then
ThisWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Main"
End If
If .CountIfs(testedRange, ">=40", testedRange, "<=49") > 0 Then
ThisWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Second"
End If
If .CountIfs(testedRange, ">=111", testedRange, "<=112") > 0 Then
ThisWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Third"
End If
End With
End Sub
Excel VBA is not very flexible when it come to working with actual arrays. But you can work with a collection instead:
SET tabs = new Collection
And then you can add a new value to it whenever you need to (e.g. in the CASE structure):
.
..
...
Case 40 To 49
SecondSheet = True
Tabs.add "Second"
...
..
The values of the collection can be accessed almost in the same way as those of an array:
for j=1 to tabs.count
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = tabs(j)
next j
Edit:
Since the code is re-entrant, i.e. there can be several instances when Range("A" & LRow).Value will be evaluated, we must make sure, that an item is set only once. This can be done easiest with a dictionary (instead of a collection):
Set tabs = CreateObject("Scripting.Dictionary")
Now it is easy to establish, whether a particular page has already been defined before:
..
...
Case 40 To 49
SecondSheet = True
tabs("Second")=1
The page creation loop then looks like this
for each k in tabs.keys
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = k
next k
The loop iterates over the keys only. There is no need to check for duplicate entries as all unique keys will be defined and listed only once!
To do this with an array you would want to:
declare a dynamic array of strings
declare a counter for the number of elements added
set the array's size to the largest value that it could possibly be
assign elements to the array, incrementing the counter for each addition
resize the array using the counter value (or test for empty elements when accessing array)
In code that could translate into something like:
Dim Tabs() as String
Dim counter As Long
...
Redim Tabs(0 to Lastrow)
counter = 0
...
While ...
Select Case .Range("A" & lrow).Value
Case 30 To 39
Mainsheet = True
Tabs(count) = "Main"
...
Case Else
counter = counter - 1
End Select
counter = counter + 1
...
Wend
If Not counter = 0 Then
Redim Preserve Tab(0 to counter - 1)
...
'create worksheets using Tabs(), etc.
...
End If