I am busy building a Shift rotation schedule using VBA and Excel
at the moment I am sitting with a problem
In my Userform I have 434 textboxes that give the shift allocation per agent
as seen below:
Now in order to get these colours to change I have a code in every Textbox (Named A1,A2.....A31 then B1, B2,,,,,,B31 etc.)
the code goes as follows:
Private Sub A1_Change()
If A1.Text = "A" Then
A1.BackColor = &H602000
ElseIf A1.Text = "B" Then
A1.BackColor = &HC07000
ElseIf A1.Text = "C" Then
A1.BackColor = &HEED7BD
ElseIf A1.Text = "D" Then
A1.BackColor = &HF0B000
ElseIf A1.Text = "W" Then
A1.BackColor = &HFF&
ElseIf A1.Text = "M" Then
A1.BackColor = &H808080
ElseIf A1.Text = "S" Then
A1.BackColor = &HA6A6A6
ElseIf A1.Text = "P" Then
A1.BackColor = &H7D7DFF
ElseIf A1.Text = "L" Then
A1.BackColor = &HD9D9D9
End If
End Sub
I am trying now to allow the user to edit the shifts manually, Once this is done, they would be able to click on a set button that will copy the data from the Specific Agents row onto the worksheet based on the month selected for example:
Private Sub CommandButton2_Click()
If Sheets(3).Range("B5").Text = "2018-01-01" Then
Worksheets("LAYOUT").Activate
Sheets("LAYOUT").Range(B4).Text = A1.Value
Sheets("LAYOUT").Range(C4).Text = A2.Value
Sheets("LAYOUT").Range(D4).Text = A3.Value
Sheets("LAYOUT").Range(E4).Text = A4.Value
Sheets("LAYOUT").Range(F4).Text = A5.Value
.
.
.
.
Sheets("LAYOUT").Range(AD4).Text = A29.Value
Sheets("LAYOUT").Range(AE4).Text = A30.Value
Sheets("LAYOUT").Range(AF4).Text = A31.Value
ElseIf Sheets(3).Range("B5").Text = "2018-02-01" Then
Worksheets(1).Activate
Sheets("LAYOUT").Range(AG4).Text = A1.Value
.
.
.
.
.
Sheets("LAYOUT").Range(BJ4).Text = A30.Value
Sheets("LAYOUT").Range(BK4).Text = A31.Value
ElseIf Sheets(3).Range("B5").Text = "2018-03-01" Then
Worksheets(1).Activate
Sheets("LAYOUT").Range(BI4).Text = A1.Value
Sheets("LAYOUT").Range(BJ4).Text = A2.Value
ect
Now when I make a change and click on the CommandButton2
it does nothing... Where am I going wrong?
Wow, that's... um... really something. You get an 'A' for for Determination, but a "C-" for Study Skills. (I mean that in the kindest way possible!) :)
There are a lot of ways to create a dynamic multicolored form like this (with no sensitive code available to the users) and you pretty much picked the hardest and most complicated way. Unfortunately, complicating simple tasks tends to make them more likely to break in the future for a small reason, and then it can take forever to figure out the problem, if you're baby doesn't crash altogether, losing all your data.
I don't think I've ever seen a Too Many Variables error before! (Even Excel wants you to simplify.) Sorry if this doesn't qualify as an answer, but I think you're best best it to start over with your formatting in a proper way.
omg, "5208 lines of code left") IF you know exactly how many lines of code you have left, you are being way too repetitive! The whole point of Excel, or VBA, or coding in general, is make the computer do the work!
If you're concerned about learning new Excel features, don't be. You obviously have some skill & organization to have made it as far as you did on that! There are some basic things you should teach yourself in Excel...
Some things to learn, ASAP (you will be glad you did!)
Select..Case statements (instead of ElseIf ElseIf ElseIf)
With..End With statements (instead of A1.BackColor A1.BackColor A1.BackColor)
VLookup (store reusable values in tables)
Match / Index
Protecting Worksheets in Excel
CONDITIONAL FORMATTING! (Automatically change a cell's color etc based on a value or a formula.)
Arrays! Both for storage (like color names and cell trigger values) and for control.
VBA Events! (Make stuff happen automatically when other stuff happens) --from the website of Chip Pearson (the king of Excel)
Making a static web page of an Excel Page
Some of Excel's amazing built-in features
Microsoft Excel formulas and features that you need to know
ExcelGuru Forums
and even: Rotating Shift Schedule Templates for Excel (that are ready to use, free, you can adapt as you need, built by professionals)
Good luck... Those are some nice color choices!
The best way to solve this issue is to start creating modules for each "action" that you want to do, for example to insure the colors in the textboxes make one Module and call it "Colour_Text" as an example is would look something like this
Public Sub Colour_Text1()
If PA1.Text = "S1" Then
PA1.BackColor = RGB(0, 32, 96)
PA1.ForeColor = RGB(255, 255, 255)
PA1.Font.Bold = True
ElseIf PA1.Text = "S2" Then
PA1.BackColor = RGB(0, 112, 192)
PA1.ForeColor = RGB(255, 255, 255)
PA1.Font.Bold = True
ElseIf PA1.Text = "S3" Then
PA1.BackColor = RGB(189, 215, 238)
PA1.ForeColor = RGB(0, 0, 0)
PA1.Font.Bold = True
ElseIf PA1.Text = "S4" Then
PA1.BackColor = RGB(0, 176, 240)
PA1.ForeColor = RGB(0, 0, 0)
PA1.Font.Bold = True
ElseIf PA1.Text = "W" Then
PA1.BackColor = RGB(60, 60, 60)
PA1.ForeColor = RGB(255, 255, 255)
PA1.Font.Bold = True
ElseIf PA1.Text = "P" Then
PA1.BackColor = RGB(166, 166, 166)
PA1.ForeColor = RGB(0, 0, 0)
PA1.Font.Bold = True
ElseIf PA1.Text = "A" Then
PA1.BackColor = RGB(255, 0, 0)
PA1.ForeColor = RGB(0, 0, 0)
PA1.Font.Bold = True
ElseIf PA1.Text = "S" Then
PA1.BackColor = RGB(169, 208, 142)
PA1.ForeColor = RGB(0, 0, 0)
PA1.Font.Bold = True
ElseIf PA1.Text = "L" Then
PA1.BackColor = RGB(0, 176, 80)
PA1.ForeColor = RGB(0, 0, 0)
PA1.Font.Bold = True
ElseIf PA1.Text = "F" Then
PA1.BackColor = RGB(112, 48, 160)
PA1.ForeColor = RGB(0, 0, 0)
PA1.Font.Bold = True
ElseIf PA1.Text = "N" Then
PA1.BackColor = RGB(255, 125, 125)
PA1.ForeColor = RGB(0, 0, 0)
PA1.Font.Bold = True
ElseIf PA1.Text = "UL" Then
PA1.BackColor = RGB(0, 176, 80)
PA1.ForeColor = RGB(169, 208, 142)
PA1.Font.Bold = True
ElseIf PA1.Text = "US" Then
PA1.BackColor = RGB(169, 208, 142)
PA1.ForeColor = RGB(255, 0, 0)
PA1.Font.Bold = True
ElseIf PA1.Text = "UN" Then
PA1.BackColor = RGB(255, 125, 125)
PA1.ForeColor = RGB(255, 0, 0)
PA1.Font.Bold = True
ElseIf PA1.Text = "H" Then
PA1.BackColor = RGB(255, 192, 0)
PA1.ForeColor = RGB(255, 0, 0)
PA1.Font.Bold = True
End If
End Sub
You then do the same for all the other text boxes, you can then call the module when you change the Text box like this:
Private Sub PA1_Change()
Call Module1.Colour_Text1
End Sub
This way you are only calling small changes thus freeing up your Memory :)
Related
Dear Stackoverflow experts,
I am trying to write a code that will let me select a number of shapes, then prompt me what color should I fill up for each selected shape.
While the following code work well for me
Sub ChangeColorBasedonInput()
Dim myColor(1 To 10) As Long
Dim x As Integer
Dim z As Integer
Dim colorChoice As Integer
myColor(1) = RGB(77, 60, 47)
myColor(2) = RGB(207, 189, 155)
myColor(3) = RGB(192, 113, 86)
myColor(4) = RGB(232, 199, 103)
myColor(5) = RGB(174, 176, 179)
myColor(6) = RGB(164, 55, 37)
myColor(7) = RGB(237, 215, 157)
myColor(8) = RGB(123, 125, 128)
myColor(9) = RGB(230, 182, 164)
myColor(10) = RGB(70, 71, 73)
On Error Resume Next
z = ActiveWindow.Selection.ShapeRange.Count
For x = 1 To z
With ActiveWindow.Selection.ShapeRange(x)
colorChoice = InputBox("Please select the color you want for Shape " & x & ", from 1 - 10")
.Fill.ForeColor.RGB = myColor(colorChoice)
End With
Next x
End Sub
I realize its quite hassle to have to enter the color choice one by one, so I try to write the code below so that I only need to enter my fill color selection once (from the above array and it will automatically fill up the shapes for me. eg when I select 7, I hope it fills the shapes from myColor(7) onwards. But somehow the following codes doesn't work. Wonder if anyone could point out my mistake here.
Sub ChangeColorBasedon_EnterOnceOnly()
Dim myColor(1 To 10) As Long
Dim x As Integer
Dim z As Integer
Dim colorChoice As Integer
myColor(1) = RGB(77, 60, 47)
myColor(2) = RGB(207, 189, 155)
myColor(3) = RGB(192, 113, 86)
myColor(4) = RGB(232, 199, 103)
myColor(5) = RGB(174, 176, 179)
myColor(6) = RGB(164, 55, 37)
myColor(7) = RGB(237, 215, 157)
myColor(8) = RGB(123, 125, 128)
myColor(9) = RGB(230, 182, 164)
myColor(10) = RGB(70, 71, 73)
On Error Resume Next
z = ActiveWindow.Selection.ShapeRange.Count
colorChoice = InputBox("Please select the color you want for Shape " & x + 1 & ", from 1 - 10")
For x = 1 To z
With ActiveWindow.Selection.ShapeRange(x)
.Fill.ForeColor.RGB = myColor(colorChoice)
End With
colorChoice = colorChoice + x
Next x
End Sub
Just before Next x add
If colorChoice > UBound(myColor) Then colorChoice = LBound(myColor)
or you may exceed the bounds of the array if too many shapes are selected
I am trying to draw a line in a PowerPoint presentation. I cannot get the desired combinations of colour, weight, zorder and to name it.
I have two ways to draw a line.
The first:
Set oLine = MyDocument.Shapes.AddLine(MyShape.Left + MyShape.Width, MyShape.Top + (MyShape.Height * 0.5) - 5, MyDocument.Shapes(lineName).Left, MyDocument.Shapes(lineName).Top + (0.5 * MyDocument.Shapes(lineName).Height)).Line
With oLine
.ZOrder (msoSendToBack)
.Line.Weight = 7
.Fill.ForeColor.RGB = RGB(0, 0, 0)
.Name = "Line"
End With
With this only the zorder works. The colour of the line is a shade of blue (which I believe was used earlier in the PowerPoint).
The second:
With MyDocument.Shapes.AddLine(MyShape.Left + MyShape.Width, MyShape.Top + (MyShape.Height * 0.5), MyDocument.Shapes(lineName).Left, MyDocument.Shapes(lineName).Top + (0.5 * MyDocument.Shapes(lineName).Height)).Line
.ForeColor.RGB = RGB(0, 0, 0)
.Weight = 5
End With
This gives the desired colour and weight, but I cannot find a way to zorder the shape nor name it.
How can I achieve all of my desired combinations?
Lines don't use a fill, only 2D shapes.
It's easier to find errors if you break long commands (like the one starting with Set oLine) into smaller chunks until you get it working. You omitted information about the MyShape from which you're getting positions, but here is a revised version of your code that runs:
Sub FormatLine()
Dim oLine As Shape
Set oLine = ActivePresentation.Slides(1).Shapes.AddLine(BeginX:=10, BeginY:=10, EndX:=40, EndY:=40)
With oLine
.ZOrder (msoSendToBack)
.Line.Weight = 7
.Line.ForeColor.RGB = RGB(0, 0, 0)
.Name = "Line3"
End With
End Sub
I have a userform being populated by a series of dependent comboboxes using a for loop to cycle through the corresponding cells of the selection made from the comboboxes and filling in the corresponding texboxes.
This is all working.
I want to color the textboxes based on a limit specified in another textbox.
Basically it looks as follows
User Form Image
I'm using a case statement to specify my range based on the number in the Limit textbox using Green, orange and red for 0, anything within the limit indicated, and anything above. They are sometimes coloring incorrectly.
Form - Working
Form - Not Working
Private Sub TextBox6_Change()
Select Case TextBox5.Value
Case 0: TextBox5.BackColor = RGB(14, 237, 59)
Case 1 To TextBox6.Value: TextBox5.BackColor = RGB(237, 181, 14)
Case Else: TextBox5.BackColor = RGB(250, 0, 12)
End Select
End Sub
Private Sub TextBox8_Change()
Select Case TextBox7.Value
Case 0: TextBox7.BackColor = RGB(14, 237, 59)
Case 1 To TextBox8.Value: TextBox7.BackColor = RGB(237, 181, 14)
Case Else: TextBox7.BackColor = RGB(250, 0, 12)
End Select
End Sub
Private Sub TextBox10_Change()
Select Case TextBox9.Value
Case 0: TextBox9.BackColor = RGB(14, 237, 59)
Case 1 To TextBox10.Value: TextBox9.BackColor = RGB(237, 181, 14)
Case Else: TextBox9.BackColor = RGB(250, 0, 12)
End Select
End Sub
Private Sub TextBox12_Change()
Select Case TextBox11.Value
Case 0: TextBox11.BackColor = RGB(14, 237, 59)
Case 1 To TextBox12.Value: TextBox11.BackColor = RGB(237, 181, 14)
Case Else: TextBox11.BackColor = RGB(250, 0, 12)
End Select
End Sub
I added the case statements to the Limit textbox change subs as these are filled after the textboxes above.
When I use F8 to cycle through the code, the textbox values are filling correctly.
Any help would be great. I cant seem to get the ELSEIF with the AND to work.
I am using a user-form. When they press the button the user form appears with check boxes. I am having trouble when both check boxes are checked. individually they work fine,
I am not sure what i am doing wrong. any help would be greatly appreciated
If Intact.Value = True Then
storDate = Sheets("escalation").Cells(Selection.Row, 2)
storProject = Sheets("escalation").Cells(Selection.Row, 3)
StorBill = Sheets("escalation").Cells(Selection.Row, 4)
storIntact = "Intact"
With objWord.ActiveDocument
.formfields("text2").Result = storDate
.formfields("Text3").Result = storProject
.formfields("Text4").Result = StorBill
.formfields("Text9").Result = storIntact
End With
ElseIf Compugen.Value = True Then
storDate = Sheets("escalation").Cells(Selection.Row, 2)
storProject = Sheets("escalation").Cells(Selection.Row, 3)
StorBill = Sheets("escalation").Cells(Selection.Row, 4)
storCompugen = "Compugen"
With objWord.ActiveDocument
.formfields("text2").Result = storDate
.formfields("Text3").Result = storProject
.formfields("Text4").Result = StorBill
.formfields("Text9").Result = storCompugen
End With
ElseIf Intact.Value And Compugen.Value = True Then
storDate = Sheets("escalation").Cells(Selection.Row, 2)
storProject = Sheets("escalation").Cells(Selection.Row, 3)
StorBill = Sheets("escalation").Cells(Selection.Row, 4)
storIntact = "Intact"
storDate1 = Sheets("escalation").Cells(Selection.Row, 2)
storProject1 = Sheets("escalation").Cells(Selection.Row, 3)
StorBill1 = Sheets("escalation").Cells(Selection.Row, 4)
storCompugen = "Compugen"
With objWord.ActiveDocument
.formfields("text2").Result = storDate
.formfields("Text3").Result = storProject
.formfields("Text4").Result = StorBill
.formfields("Text9").Result = storIntact
.formfields("text5").Result = storDate1
.formfields("Text6").Result = storProject1
.formfields("Text7").Result = StorBill1
.formfields("Text8").Result = storCompugen
End With
End If
Thanks in advance
Try changing the order. Otherwise as soon as one condition is met the If clause is exited.
If Intact.Value And Compugen.Value Then
'code
ElseIf Intact.Value Then
'code
ElseIf Compugen.Value Then
'code
End If
If Intact.Value = True is true then the first, not the third block will run.
Similarly if Intact.Value = True is not true and Compugen.Value = True is true, then the second block will run.
So you can see that the third block is not reachable.
The solution is to put the Intact.Value = True And Compugen.Value = True case first in the group.
Finally, Foo.Value = True is a tautology of the simpler Foo.Value. You can drop all the explicit = True comparisons.
Using a macro in excel 2007 I want to display the following errorbars:
No horizontal errorbar.
Red dashed with 100 plus value vertical errorbar.
I can get everything I want except the color and I don't understand why. Below is the code.
ActiveChart.SeriesCollection(6).HasErrorBars = True
With ActiveChart.SeriesCollection(6).ErrorBars
.EndStyle = xlNoCap
.Format.Line.Visible = msoTrue
.Format.Line.ForeColor.RGB = RGB(255, 0, 0)
.Format.Line.ForeColor.TintAndShade = 0
.Format.Line.Weight = 2
.Format.Line.DashStyle = msoLineDash
End With
ActiveChart.SeriesCollection(6).ErrorBar Direction:=xlX, Include:=xlNone, Type:=xlFixedValue, Amount:=0
ActiveChart.SeriesCollection(6).ErrorBar Direction:=xlY, Include:=xlPlusValues, Type:=xlFixedValue, Amount:=100
I ran into the same issue too. But after toggling the visible state of the error bars, the color change worked for me. Give this a try:
ActiveChart.SeriesCollection(6).HasErrorBars = True
With ActiveChart.SeriesCollection(6).ErrorBars
.EndStyle = xlNoCap
.Format.Line.Visible = msoTrue
.Format.Line.ForeColor.RGB = RGB(255, 0, 0)
.Format.Line.Visible = False 'ADDED
.Format.Line.Visible = True 'ADDED
.Format.Line.ForeColor.RGB = RGB(255, 0, 0) 'ADDED
.Format.Line.ForeColor.TintAndShade = 0
.Format.Line.Weight = 2
.Format.Line.DashStyle = msoLineDash
End With