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
Related
I'm working on a project and need at the moment to find the first empty cell just after text cells in a row in Excel. To clarify, let me explain to you what I'm lookng for with this screenshot
I want to write a code to return for me for like an example in the case of the 20th row the number of column of the cell E20 even if the first empty cell is A20 but like I said, i want the first empty cell juste after the last "not empty" one.
for the 21th row the result will be C21, the 22th row it will be F22 and there you go
Here's the code I wrote but for some reason it doesn't work, please help.
Function emptyCell(ws As Worksheet, ligne As Integer)
Dim m, p, n As Integer
Dim suite(700) As Integer
For k = 0 To 700
suite(k) = 0
Next
emptyCell = 0
i = 1
Do Until suite(i) = 0 And suite(i - 1) = 1
If ws.Cells(ligne, i) <> "" Then
suite(i) = 1
End If
i = i + 1
emptyCell = emptyCell + 1
Loop
End Function
Sub test()
Dim d As Integer
empty_cell = emptyCell(Sheets("tmp"), 2)
MsgBox (empty_cell)
End Sub
The logic of my code is to assign 0 for empty cells and 1 in the other caase, run a test to find the first 1-0 that's gonna appear in my array and get the column order from the order of this "1"
I know I'm not that clear cause I didnt want it to make it a long post and english is not my first language.
Thanks in advance
All if you want to get the first empty cell after the last non empty cell, why not try it like this?
Function emptyCell(ws As Worksheet, Row As Long) As Range
Set emptyCell = ws.Cells(Row, ws.Columns.Count).End(xlToLeft).Offset(, 1)
End Function
Sub Test()
Dim empty_cell As Range
Set empty_cell = emptyCell(Sheets("tmp"), 20)
MsgBox empty_cell.Address
End Sub
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
This is what my cells look like:
This is my code, I'll explain it below.
Sub Macro1()
Dim product as String
Dim group as Long
Dim recordno as Long
dim pol_number as Long
dim plan_name as Long
product = "corp"
group = 1
recordno = 1
pol_number = 1
plan_name = "TTT"
Range("A2").Select
For i = 1 to 5
ActiveCell.Value = Selection.End(xlUp).Value
ActiveCell.Offset(0,1).Select
Next i
End Sub
I want to fill in all of the cells with the variable values. I understand that variables are not case sensitive, and I understand that the code I have will just fill the cell with the text in the upmost cell of the column, but I don't know if there is a function that would take the text of the top cell and convert it to a variable. Is that possible?
Try this to go from variables to cells
Dim values as Variant
'Array 0 to 4
values = Array(product,group,recordno,pol_number,plan_name)
Range("A2").Resize(1,5).Value2 = values
The reverse is
Dim values as Variant
'Array 1 to 5
values = Range("A2").Resize(1,5).Value2
product = values(1,1)
group = values(1,2)
recordno = values(1,3)
pol_number = values(1,4)
plan_name = values(1,5)
If you do something like
someCell.Value = someOtherCell.Value
and someOtherCell.Value is "product" then someCell won't be filled with what you have saved in the variable product but with "product" (I included the quotation marks to emphasize that's it's a string). That's a good thing because otherwise it would mess your code up if you accidentally put in the name of some random variable in your code.
If your requirements are like this:
You have values for PRODUCT etc that you write to write in the row below PRODUCT etc.
The headers are not always in the same order.
You might want to add new variables later on without too much fuss.
Them some kind of keyed list might be what your looking for. That means that rather than referencing the variable by a numerical index, you can reference them using names.
If the order is fixed, you might be better of just using an array where item 1 is the product name, item 2 is the group number etc, like ja72 and Sgdva suggested.
However, if you still want to reference the variables by name, you could use a collection:
Dim coll As New Collection
With coll
.Add "corp", "product"
.Add 1, "group"
.Add 1, "recordno"
'...
End With
Then instead of selecting cells and referencing ActiveCell you should reference the cells directly (using selections and ActiveCell can be avoided most of the times and slows down the macro and can even cause unnecessary errors)
For i = 1 To 5
Cells(2, i).value = coll(Cells(1, i).value)
Next i
An alternative to a collection is a dictionary which offers an easy way to check if a key exists (with a collection you have to catch the error)
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
With dict
.Add "product", "corp"
.Add "group", 1
.Add "recordno", 1
'...
End With
Now you can check if the entry exists first so it won't throw an error:
For i = 1 To 5
If dict.Exists(LCase(Cells(1, i).value)) Then 'note that the dictionary keys are case sensitive
Cells(2, i).value = dict(LCase(Cells(1, i).value))
Else
MsgBox "Entry for " & LCase(Cells(1, i).value) & " not found!"
End If
Next i
Note that when you use dict("somekey") and the entry "somekey" doesn't exist, it won't throw an error but add an empty entry.
Why not an array and then loop through the elements as needed?
Dim ArrayTitles() As Variant 'since strings and numbers are mixed
ReDim Preserve ArrayTitles(5)
ArrayTitles(1) = "corp"
ArrayTitles(2) = 1
ArrayTitles(3) = 1
ArrayTitles(4) = 1
ArrayTitles(5) = "TTT"
Range("A2").Select
For i = 1 To 5
MsgBox (ArrayTitles(i))
I'm thinking what you are trying to accomplish can be solved in this way
for j = 1 to 6 'Or whatever your last column happens to be
if UCase(cells(1, j)) = "PRODUCT" then
if ActiveCell.Column = j then
ActiveCell.Value = "corp"
end if
end if
next j
Something like that?
I have 2 sheets: sheet1 and sheet2. I have a value in cell A3 (sheet1) which is not constant. And many files in sheets2.
What I would like to do, is when the value in cell A3 (Sheet1) is the same as the value in the column A (Sheet2), it will delete the entire row where is find this value (Sheet2).
This is my attempt. It doesn't work: no rows are deleted.
If Worksheets("Sheet1").Range("A3").Text = Worksheets("Sheet2").Range("A:A").Text Then
Dim f As String
f = Worksheets("Sheet1").Range("A3")
Set c = Worksheets("Sheet2").Range("A:A").Find(f)
Worksheets("Sheet2").Range(c.Address()).EntireRow.Delete
End If
My guess is that you're not finding anything with the .Find(). Since you're not checking it for is Nothing you don't know. Also, .Find() retains all the search parameters set from the last time you did a search - either via code or by hand in your spreadsheet. While only the What parameter is required, it's always worth setting the most critical parameters (noted below) for it, you may want to set them all to ensure you know exactly how you're searching.
Dim f As String
If Worksheets("Sheet1").Range("A3").Text = Worksheets("Sheet2").Range("A:A").Text Then
f = Worksheets("Sheet1").Range("A3")
Set c = Worksheets("Sheet2").Range("A:A").Find(What:=f, Match:=[Part|Whole], _
LookIn:=[Formula|value])
if not c is Nothing then
Worksheets("Sheet2").Range(c.Address()).EntireRow.Delete
else
MsgBox("Nothing found")
End If
End If
Go look at the MS docs to see what all the parameters and their enumerations are.
Sub Test()
Dim ws As Worksheet
For x = 1 To Rows.Count
If ThisWorkbook.Sheets("Sheet2").Cells(x, 1).Value = ThisWorkbook.Sheets("Sheet1").Cells(3, 1).Value Then ThisWorkbook.Sheets("Sheet2").Cells(x, 1).EntireRow.Delete
Next x
End Sub