Use one Macro for multiple instances - vba

I'm trying to use Excel VBA to control text box background colors depending on the values in certain cells. Each text box corresponds to a different cell with a value in it. I have about 60 text boxes to control and 4 possible colors for each one. Using switch statements, I would basically have to do 4 cases for each of the 60 text boxes... Assuming I use the way I have it set up now as seen below:
Select Case Cells(50, 2).Value
Case Is = 1, 6, 11, 16
.TextBox13.BackColor = RGB(0, 255, 0)
Case Is = 5
.TextBox13.BackColor = RGB(255, 0, 0)
Case Is = 0
.TextBox13.BackColor = RGB(255, 255, 255)
Case Is = 10, 15
.TextBox13.BackColor = RGB(255, 255, 0)
End Select
And so on for all 60. However, the value range is always the same, and the colors correspond with the same values for each one. I'm assuming there must be a way to build one module to actually set the colors, and just use switch statements to determine with cell to send to that module?
EDIT: I've attached a screenshot of the workspace so you can see what I'm going for

Some piece of your code is wrong. It's Select Case ... End Select
Select Case Cells(50, 2).Value
Case 1, 6, 11, 16
tbxObject.BackColor = RGB(0, 255, 0)
Case 5
tbxObject.BackColor = RGB(255, 0, 0)
Case 0
tbxObject.BackColor = RGB(255, 255, 255)
Case 10, 15
tbxObject.BackColor = RGB(255, 255, 0)
End Select
Please, see: Select ... Case statement
If some piece of code is used several times, you have to move it into single general soubroutine, which can accept TextBox object as input parameter.
Sub ColorMyTextBox(wsh As Worksheet, sTextBoxName As String)
Dim txtObject As OleObject
Set txtObject = wsh.OleObjects(sTextBoxName)
If TypeName(txtObject) <> "TextBox" Then Goto Exit_Sub
'here Select Case statement
Exit_Sub:
End Sub
Got it?

Ok, so if I use that, how will I specify the cell numbers to use in the case statements? It won't always be cells(50,2)... And I also get errors when sending the worksheet name

Related

VBA UserForms - comparind data in userform

I have two files. One file is with specification, second with the reuslts. I've created UserForm where I can compare if result is within the specified range & result is assessed as OK or NOK.
Spec
Results
Results & specification is saved from excel to tables & from table are populated into UserForm. During this, I met situation where randowm result (not the same) is within the range of specification but final Judgment is NOK. All data (spec& results) are in "General" format.
UserForm
When I will write the same result manualy, then Judgment is OK. I have 14 windows which are working with below the same code (numbers are just different)
Private Sub txtVal14_AfterUpdate()
Val14 = CofC_FORM.txtVal14.Value
If CofC_FORM.Test14 <> "" Then
If CofC_FORM.Val14 >= CofC_FORM.Min14 Then
If CofC_FORM.Val14 <= CofC_FORM.Max14 Then
CofC_FORM.Jud14.Caption = "OK"
CofC_FORM.Jud14.BackColor = RGB(102, 255, 51)
Else: CofC_FORM.Jud14.Caption = "NOK"
CofC_FORM.Jud14.BackColor = RGB(255, 51, 0)
End If
Else: CofC_FORM.Jud14.Caption = "NOK"
CofC_FORM.Jud14.BackColor = RGB(255, 51, 0)
End If
Else: CofC_FORM.Jud14.Caption = ""
End If
End Sub
I thought there are string valuse to compare & I implemented in the step before below code to change string to the number:
For Each r In Sheets(i).Range("G23:G28").SpecialCells(xlCellTypeConstants)
r.Select
r.NumberFormat = "0.00"
String1 = r.Value
String1 = Replace(String1, ",", ".")
r.Value = CSng(String1)
Next r
Can someone help me ? Do you have any idea what could be the problem as I think, aboce code is OK.

Powerpoint VBA - How to store information 'within' shape?

Say I have the following code within a sub:
With square
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.Fill.Transparency = 1
.Name = "Foo"
End With
I can now define searches based on its .Name and even use that name within the code (for instance, I could set some String value to the name of the shape).
My question is - is there another way for me to store values 'within' a shape? Specifically, multiple Strings and Integers.
If no, when I am setting the text of a shape based on some String and Integer variables within a Sub, is there a way to allow a different Sub to use those bits of information?
You may use square.tags collection - square.tags.Add "NAME",VALUE
There is an example
With square
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.Fill.Transparency = 1
.Name = "Foo"
.Tags.Add "Tag 1", 1
.Tags.Add "Tag 2", 2
' Reading
For a = 1 To .Tags.Count
Debug.Print .Tags.Name(a), .Tags.Value(a)
Next a
End With

Selecting a Catia part in a for loop

There is a small error in my For loop as it will not select the part that I want to color. I used a variable hash to put all the names of the document there and then tried the Catia function to color, but still got nothing!
Below is a part fo the code.
Problem zone is the Select Case. It wont actually select and color the part if found.
UPDATE: now i know exactly where the problem is, it is inside case during selection of the part and coloring it. somehow it wont even select the part.
For n = 1 To DokAnzahl
Set Dokument = DokumentArray(n)
ReDim DokumentArrayNew(DokAnzahl)
DokumentArrayNew(n) = CStr(Dokument.Name)
For j = 1 To UBound(arrNamen)
If arrNamenNew(j) = Left(DokumentArrayNew(n), Len(arrNamenNew(1))) Then
'MsgBox "They are equal!"
hash = DokumentArrayNew(n)
ColorCode(j) = arrFarben(j)
'MsgBox ColorCode(j) checked
m = j+1
Select Case ColorCode(j)
Case "NEU" 'rot
Set sel = catia.activedocument.selection
sel.search "Name =hash,all"
sel.visproperties.setRealColor 240, 1, 1, 1
Case "entfällt" 'Gelb
Set sel = catia.activedocument.selection
sel.search "Name =hash,all"
sel.visproperties.setRealColor 240, 240, 16, 1
Case "COP" 'Grün
Set sel = catia.activedocument.selection
sel.search "Name =hash,all"
sel.visproperties.setRealColor 30, 240, 60, 1
Case Else
MsgBox "no color info"
End Select
End If
Next
Next
Your Selection.Search is searching for the word "Hash" and not what is inside the variable hash
Change your Select Case statements to this:
Set sel = catia.activedocument.selection
sel.search "Name =*" & hash & "*,all"

excel vba change textbox based on values

I am trying to change the font color based on the values in the cells(16,3).
For some reason it is not working. The present value at 16,3 is 94% and it is showing up in green color instead of amber. Your help would be appreciated.
Private Sub TextBox1_Change()
TextBox1.Value = Cells(16, 3).Text
Cells(16, 3).Font.Bold = True
If TextBox1.Value > 95 Then TextBox1.ForeColor = RGB(0, 128, 0) 'Green
If TextBox1.Value > 80 And TextBox1.Value < 95 Then TextBox1.ForeColor = RGB(255, 153, 0) 'Amber
If TextBox1.Value < 80 Then TextBox1.ForeColor = RGB(255, 0, 0) 'Red
End Sub
You'll get that result if the value in the cell is in text format rather than as an actual value. Is it possible that that's the case?
The other thing to bear in mind, though this wouldn't be the cause of your existing problem or the text would always be red, is that 94% is actually 0.94, not 94.
Edit: (I'm doing an edit to my original answer in response to the comment because I need to include code which does not go into comments well)
You have a few other problems.
The first is that if this is being driven by the value in cell(16,3) I'm not sure that you should be driving it from the Textbox1_Change event. By doing that you are waiting for someone to enter a value into that text box and immediately overwriting it with whatever is in that cell. Better to populate the entry during the form load.
Much depends on what you're trying to do with this, and I have no information on that.
Second, if you step through the code you'll find that TextBox1.Value is returning a string; it has double quotes around it. But you are comparing it to a numeric set of values.
The third is that your code does not deal with the situation where there is an exact match of (say) 80%.
The fourth is that if you suck the value straight from the cell, and it really is a percentage value, it'll come up as 0.94, not formatted as a percentage.
This deals with the lot.
Dim rng As Excel.Range
Set rng = ActiveSheet.Cells(16,3)
TextBox1.Value = Format(rng.Value, "00%")
rng.Font.Bold = True
'You should really implement error checking here.
'There's no point reading the value from the textbox if it's coming from a cell.
'Just use the cell value.
If rng.Value >= 0.95 Then
TextBox1.ForeColor = RGB(0, 128, 0) 'Green
ElseIf rng.Value >= 0.8 And rng.Value < 0.95 Then
TextBox1.ForeColor = RGB(255, 153, 0) 'Amber
ElseIf rng.Value < 0.8 Then
TextBox1.ForeColor = RGB(255, 0, 0) 'Red
End If
Set rng = Nothing
If you use
TextBox1.Value = Cells(16, 3).Value
instead of
TextBox1.Value = Cells(16, 3).Text
You will see the real values used in your if statements. And result will be like below:
If Text Type of related cell is : "General"
And if you use related cell type as "Percentage". You will get following results
So, depending on your preferences you can either use the cell value as general or you can convert it in the macro from percentage to general and display it as it is.
If you want to keep using Percentage in your related sheet which means actually as value you will have 0.XX in that cell however it will display as XX%, then you can simply multiply your value with 100 as follows:
TextBox1.Value = Cells(16, 3).Value * 100

Shape Name by Reference and Looping doesnt work

Im Creating a subroutine as below to Refer a Cell and coulor the shape.
In my Code the H value (Name) is not working. Please help.
Sub Erectioncolour()
J = 9
H = 1
Do
If Worksheets("Vertical Chart").Cells(J, 25).Value <> "" Then
Worksheets("Visual Chart").Shapes(H).Fill.ForeColor.RGB = RGB(5, 0, 0)
Else
Worksheets("Visual Chart").Shapes(H).Fill.ForeColor.RGB = RGB(255, 255, 255)
End If
J = J + 1 And H = H + 1
Loop While J = 268
End Sub
In my Code the H value (Name) is not working.
Yes, it is actually working.
Your problem is with the conditional If Worksheets("Vertical Chart").Cells(J, 25) <> "". Row 25 in that worksheet is empty, after column K. So for every value of J greater than 10, it will not apply the RGB(5, 0, 0), but instead applies the RGB(255, 255, 255) as the False part of the test.
So the True part of your If/Else statement is only being executed once. After that, they all evaluate to False, so the shapes are being correctly (according to the code) applied with the following from your Else statement:
Worksheets("Visual Chart").Shapes(H).Fill.ForeColor.RGB = RGB(255, 255, 255)
Solution:
You need to change your logic in the If statement, or, specify a non-white RGB value.
Updated to explain how IF statements work...
THere are two parts to your If statement, a True part which colors the shapes with RGB(5, 0, 0) and a False part which colors the shapes with RGB(255, 255, 255) (white). As your file is currently configured, the statement evaluates False for every value of J in {9,11,12,..., 268}. This is conditional based on the logic AND the data (or lack thereof) in the worksheet.
If you don't want these shapes to be white, then you need to assign a different RGB value. Which one you choose is up to you, for example .RGB(6, 255, 255) looks turquoise.
Or the other possibility is that your If statement's test is incorrect. If that is not correct, then I cannot help you until you describe how the test should be working, because the current test will always do what it is doing right now, until the cells in Row 25 are non-blank.