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 :)
working in vb.net in Visual Studio on a datagridview.
The rows are days of the week. The rows all alternate backcolor (variables LightColour1 and LightColour2), then the weekend rows are variable WeekendRowsColour. That's all easy enough, but now I have to make the entire final column white. But I can't seem to override the row colors no matter how I approach it. Any advice?
Here's my code section:
For r = 0 To 27
dgv.Rows.Add()
dgv.Rows(r).Cells(0).Value = Format(nDate, "ddd")
dgv.Rows(r).Cells(1).Value = Format(nDate, "d/MM/yyyy")
If Format(nDate, "ddd") = "Sat" Or Format(nDate, "ddd") = "Sun" Then
dgv.Rows(r).DefaultCellStyle.BackColor = WeekendRowsColour
dgv.Rows(r).DefaultCellStyle.SelectionBackColor = WeekendRowsSelColour
Else
If r Mod 2 = 0 Then 'even row
dgv.Rows(r).DefaultCellStyle.BackColor = LightColour1
dgv.Rows(r).DefaultCellStyle.SelectionBackColor = SelLightColour1
Else 'alternate row
dgv.Rows(r).DefaultCellStyle.BackColor = LightColour2
dgv.Rows(r).DefaultCellStyle.SelectionBackColor = SelLightColour2
End If
End If
nDate = DateAdd(DateInterval.Day, 1, nDate)
Next
dgv.Columns(dgv.Columns.Count - 1).DefaultCellStyle.BackColor = Color.White
But no matter how I approach it, the last column comes out the default color. My best success has been setting the backcolor and alternatingrowsbackcolor of the rows programmatically, and setting the column properties to white in the designer, but that doesn't overwrite the alternating rows or the weekend colors.
Pulling my hair out here!
You have to set it inside the loop per cell like this:
For r = 0 To 27
dgv.Rows.Add()
dgv.Rows(r).Cells(0).Value = Format(nDate, "ddd")
dgv.Rows(r).Cells(1).Value = Format(nDate, "d/MM/yyyy")
If Format(nDate, "ddd") = "Sat" Or Format(nDate, "ddd") = "Sun" Then
dgv.Rows(r).DefaultCellStyle.BackColor = WeekendRowsColour
dgv.Rows(r).DefaultCellStyle.SelectionBackColor = WeekendRowsSelColour
Else
If r Mod 2 = 0 Then 'even row
dgv.Rows(r).DefaultCellStyle.BackColor = LightColour1
dgv.Rows(r).DefaultCellStyle.SelectionBackColor = SelLightColour1
Else 'alternate row
dgv.Rows(r).DefaultCellStyle.BackColor = LightColour2
dgv.Rows(r).DefaultCellStyle.SelectionBackColor = SelLightColour2
End If
End If
nDate = DateAdd(DateInterval.Day, 1, nDate)
dgv.Rows(r).Cells(dgv.Columns.Count-1).Style.BackColor = Color.White
Next
I am currently programming a sheet which visualizes data sets in graphs. Because the user of this sheet will not need all the graphs, I would like to let them choose the ones needed through a UserForm. Since the amount of data sets is variable, the UserForm will have the same amount of checkboxes as there are datasets.
The Userform code is as follows.
Private Sub UserForm_Initialize()
Dim chkBoxA As MSForms.CheckBox
Dim chkBoxB As MSForms.CheckBox
Dim lblBox As MSForms.Label
Dim cnt As Control
Amount = Sheet4.Range("C4").Value 'Amount of datasets
For i = 1 To Amount
Set lblBox = Me.Controls.Add("Forms.label.1", "Label" & i)
lblBox.Caption = "Set" & i
lblBox.Left = 5
lblBox.Top = 8 + ((i - 1) * 40)
Set chkBoxA = Me.Controls.Add("Forms.CheckBox.1", "A" & i)
chkBoxA.Caption = "Graph a"
chkBoxA.Left = 55
chkBoxA.Top = 5 + ((i - 1) * 40)
Set chkBoxB = Me.Controls.Add("Forms.CheckBox.1", "B" & i)
chkBoxB.Caption = "Graph b"
chkBoxB.Left = 55
chkBoxB.Top = 20 + ((i - 1) * 40)
Next
CommandButton1.Left = 20
CommandButton1.Top = 40 + ((Amount - 1) * 40)
CommandButton1.TabIndex = Amount * 3 + 1
Me.Height = 220
Me.ScrollBars = fmScrollBarsVertical
Me.ScrollWidth = Me.InsideWidth * 9
For Each cnt In Me.Controls
If cnt.Top + cnt.Height > Me.ScrollHeight Then
Me.ScrollHeight = cnt.Top + cnt.Height + 5
End If
Next
End Sub
When the UserForm is filled in (graphs are chosen by clicking on the options), the user will press CommandButton1. An event should then be run to show the correct graph, but for the simplicity I am first testing if a MsgBox will show up. Unfortunately the MsgBox does not show up.
Private Sub CommandButton1_Click()
'Will fix this with a loop
If A1 = True Then
MsgBox ("TestA1")
End If
If B1 = True then
MsgBox ("TestB1")
End If
If A2 = True then
MsgBox ("TestA2")
End If
Unload Me
End Sub
I am stuck on this part. The checkboxes do show up on the UserForm and they are clickable, but the commandbutton only shuts down the sub (Unload Me). I would like to see the MsgBox show up when I select the corresponding option and click the commandbutton. Any help on getting this to work is appreciated!
You are referencing 'A1' in the sub, but that variable does not exitst at compile time, because you add them dynamically. What you need to do is loop the controls, to check the names. Best practice is to put the checkboxes in a frame, to be able to group them.
Add a frame to the userform and name it 'checkboxframe'
And then instead of:
For i = 1 To Amount
Set lblBox = Me.Controls.Add("Forms.label.1", "Label" & i)
lblBox.Caption = "Set" & i
lblBox.Left = 5
lblBox.Top = 8 + ((i - 1) * 40)
Set chkBoxA = Me.Controls.Add("Forms.CheckBox.1", "A" & i)
chkBoxA.Caption = "Graph a"
chkBoxA.Left = 55
chkBoxA.Top = 5 + ((i - 1) * 40)
Set chkBoxB = Me.Controls.Add("Forms.CheckBox.1", "B" & i)
chkBoxB.Caption = "Graph b"
chkBoxB.Left = 55
chkBoxB.Top = 20 + ((i - 1) * 40)
Next
you would need to do:
With Me.checkboxframe
For i = 1 To Amount
Set lblBox = .Controls.Add("Forms.label.1", "Label" & i)
lblBox.Caption = "Set" & i
lblBox.Left = 5
lblBox.Top = 8 + ((i - 1) * 40)
Set chkBoxA = .Controls.Add("Forms.CheckBox.1", "A" & i)
chkBoxA.Caption = "Graph a"
chkBoxA.Left = 55
chkBoxA.Top = 5 + ((i - 1) * 40)
Set chkBoxB = .Controls.Add("Forms.CheckBox.1", "B" & i)
chkBoxB.Caption = "Graph b"
chkBoxB.Left = 55
chkBoxB.Top = 20 + ((i - 1) * 40)
Next
End With
And to add the checkboxes to the frame, use something like:
For Each ctr In UserForm1.frame("checkboxframe").Controls
If TypeName(ctr) = "CheckBox" Then
If ctr.Value = True Then
'do something usefull here
msgbox ctr.name
End If
End If
Next ctr
The reason nothing appears is because there is no object "A1" manually defined as a variable.
To get the value of the box you Dynamically named "A1" you would have to refer to it as such:
If Me.Controls.Item("A1").Value = True then
Hope this helps!
The code below does a few things:
Iterates through a colleciton of labels I have on my Windows form, used as a placeholder
While iterating through the collection, the code is connecting to an SQL database to return a result from a query for each label (about 104 labels)
Finally some charts are populates.
I have timed this whole process and it takes about 4 or 5 seconds. My goal is to have this process performed instantly or 1 seconds or less.
Could an expert out there explain to me what I'm doing wrong and why this process takes so long?
here is the query:
Dim RESULT1 As Decimal 'declare this as global
Dim RESULT2 As Decimal 'declare this as global
Private Sub Week(ByVal week As Integer)
Dim queryString As String = "SELECT " & _
" (SELECT CAST(SUM(TARGET_SECONDS) AS DECIMAL)/ CAST(SUM(ROUTE_SECONDS) AS DECIMAL) FROM dbo.APE_BUSDRIVER_MAIN WITH(NOLOCK) WHERE ACTIVE = 1 AND EMPLOYEE_NAME = '" & cbEmployeeName.Text & "') AS RESULT1," & _
" (SELECT (SELECT CAST(COUNT(APE_BUSDRIVER_STATUS_OBJID) AS DECIMAL) FROM dbo.APE_BUSDRIVER_MAIN AS RESULT2 WHERE ACTIVE = 1 AND APE_BUSDRIVER_STATUS_OBJID= 1 AND EMPLOYEE_NAME = '" & cbEmployeeName.Text & "' )/(SELECT CAST(COUNT(APE_BUSDRIVER_STATUS_OBJID) AS DECIMAL) FROM dbo.APE_BUSDRIVER_MAIN AS RESULT2 WHERE ACTIVE = 1 AND EMPLOYEE_NAME = '" & cbEmployeeName.Text & "' )) AS RESULT2" & _
" FROM dbo.APE_BUSDRIVER_MAIN WHERE WEEK_TIME = " & week & " AND APE_AREA_OBJID = " & lblAreaOBJID.Text & " AND EMPLOYEE_NAME = '" & cbEmployeeName.Text & "' AND YEAR_TIME = '" & cbYear.Text & "' AND ACTIVE = 1"
Using connection As New SqlConnection(SQLConnectionStr)
Dim command As New SqlCommand(queryString, connection)
connection.Open()
Dim reader As SqlDataReader = command.ExecuteReader()
' Call Read before accessing data.
If reader.HasRows Then
While reader.Read()
RESULT1 = reader("RESULT1")
RESULT2 = reader("RESULT2")
End While
Else
RESULT1 = 0
RESULT2 = 0
End If
' Call Close when done reading.
reader.Close()
End Using
End Sub
Here is the code:
Private Sub LoadWeeklyStats()
For i As Integer = 0 To 51
Dim LabelWkEff As String = "LblWkEff" + (i + 1).ToString
Dim myArray1 As Array = Controls.Find(LabelWkEff, False)
Dim myControl1 As Label = myArray1(0)
myControl1.Text = RESULT1
'AND
Dim LabelDeliveryStat As String = "lblDeliveryStat" + (i + 1).ToString
Dim myArray2 As Array = Controls.Find(LabelDeliveryStat, False)
Dim myControl2 As Label = myArray2(0)
myControl2.Text = RESULT2
'COUNTER
Week(i + 1)
Next
'TO CLEAR CHART AND RELOAD IT
Chart1.Titles.Clear()
Chart1.Series.Clear()
Chart1.ChartAreas.Clear()
Chart1.ChartAreas.Add("AREA")
Chart1.Series.Add("WeeklyEfficiency")
Chart1.Series.Add("TARGET")
Chart1.Titles.Add("ROUTE EFFICIENCY")
Chart1.Series("TARGET").ChartType = SeriesChartType.Line
With Chart1.Titles(0)
.Font = New Font("TAHOMA", 12, FontStyle.Bold)
End With
With Chart1.ChartAreas(0)
'.AxisY.MajorGrid.Enabled = False
.AxisX.MajorGrid.Enabled = False
.AxisX.Title = "WEEKS"
.AxisY.Title = "EFFICIENCY"
.AxisX.Minimum = 0
.AxisX.Maximum = 53
.AxisY.Minimum = 0
.AxisX.Interval = 1
.AxisY.LabelStyle.Format = Format(0, "0%")
End With
With Chart1.Series(0)
.Font = New Font(Me.Font.Name, 7, FontStyle.Regular)
.SmartLabelStyle.Enabled = False
.LabelAngle = -90
.Label = "#VAL{P}"
.IsValueShownAsLabel = True
.Name = "WeeklyEfficiency"
.ChartType = SeriesChartType.Column
.LabelToolTip = Enabled
.ToolTip = "WEEK #VALX" & vbNewLine & "#VAL{P}"
.BorderColor = Color.Black
.LabelForeColor = Color.Transparent
Dim area As String = cbArea.Text
Select Case area
Case "BC_PICKUP"
.Color = Color.Blue
Case "BC_DELIVERY"
.Color = Color.Blue
Case "RAW"
.Color = Color.LimeGreen
Case "RTV"
.Color = Color.Yellow
Case Else
.Color = Color.Black
End Select
'LOAD DATA POINTS
With .Points
.AddXY(0, 0)
.AddXY(1, LblWkEff1.Text)
.AddXY(2, LblWkEff2.Text)
.AddXY(3, LblWkEff3.Text)
.AddXY(4, LblWkEff4.Text)
.AddXY(5, LblWkEff5.Text)
.AddXY(6, LblWkEff6.Text)
.AddXY(7, LblWkEff7.Text)
.AddXY(8, LblWkEff8.Text)
.AddXY(9, LblWkEff9.Text)
.AddXY(10, LblWkEff10.Text)
.AddXY(11, LblWkEff11.Text)
.AddXY(12, LblWkEff12.Text)
.AddXY(13, LblWkEff13.Text)
.AddXY(14, LblWkEff14.Text)
.AddXY(15, LblWkEff15.Text)
.AddXY(16, LblWkEff16.Text)
.AddXY(17, LblWkEff17.Text)
.AddXY(18, LblWkEff18.Text)
.AddXY(19, LblWkEff19.Text)
.AddXY(20, LblWkEff20.Text)
.AddXY(21, LblWkEff21.Text)
.AddXY(22, LblWkEff22.Text)
.AddXY(23, LblWkEff23.Text)
.AddXY(24, LblWkEff24.Text)
.AddXY(25, LblWkEff25.Text)
.AddXY(26, LblWkEff26.Text)
.AddXY(27, LblWkEff27.Text)
.AddXY(28, LblWkEff28.Text)
.AddXY(29, LblWkEff29.Text)
.AddXY(30, LblWkEff30.Text)
.AddXY(31, LblWkEff33.Text)
.AddXY(32, LblWkEff32.Text)
.AddXY(33, LblWkEff33.Text)
.AddXY(34, LblWkEff34.Text)
.AddXY(35, LblWkEff35.Text)
.AddXY(36, LblWkEff36.Text)
.AddXY(37, LblWkEff37.Text)
.AddXY(38, LblWkEff38.Text)
.AddXY(39, LblWkEff39.Text)
.AddXY(40, LblWkEff40.Text)
.AddXY(41, LblWkEff41.Text)
.AddXY(42, LblWkEff42.Text)
.AddXY(43, LblWkEff43.Text)
.AddXY(44, LblWkEff44.Text)
.AddXY(45, LblWkEff45.Text)
.AddXY(46, LblWkEff46.Text)
.AddXY(47, LblWkEff47.Text)
.AddXY(48, LblWkEff48.Text)
.AddXY(49, LblWkEff49.Text)
.AddXY(50, LblWkEff50.Text)
.AddXY(51, LblWkEff51.Text)
.AddXY(52, LblWkEff52.Text)
.AddXY(53, 0)
End With
End With
With Chart1.Series("TARGET")
.Name = "TARGET"
.ChartType = SeriesChartType.Line
.Color = Color.Red
.BorderWidth = 3
With .Points
.AddXY(0, 1)
.AddXY(1, 1)
.AddXY(2, 1)
.AddXY(3, 1)
.AddXY(4, 1)
.AddXY(5, 1)
.AddXY(6, 1)
.AddXY(7, 1)
.AddXY(8, 1)
.AddXY(9, 1)
.AddXY(10, 1)
.AddXY(11, 1)
.AddXY(12, 1)
.AddXY(13, 1)
.AddXY(14, 1)
.AddXY(15, 1)
.AddXY(16, 1)
.AddXY(17, 1)
.AddXY(18, 1)
.AddXY(19, 1)
.AddXY(20, 1)
.AddXY(21, 1)
.AddXY(22, 1)
.AddXY(23, 1)
.AddXY(24, 1)
.AddXY(25, 1)
.AddXY(26, 1)
.AddXY(27, 1)
.AddXY(28, 1)
.AddXY(29, 1)
.AddXY(30, 1)
.AddXY(31, 1)
.AddXY(32, 1)
.AddXY(33, 1)
.AddXY(34, 1)
.AddXY(35, 1)
.AddXY(36, 1)
.AddXY(37, 1)
.AddXY(38, 1)
.AddXY(39, 1)
.AddXY(40, 1)
.AddXY(41, 1)
.AddXY(42, 1)
.AddXY(43, 1)
.AddXY(44, 1)
.AddXY(45, 1)
.AddXY(46, 1)
.AddXY(47, 1)
.AddXY(48, 1)
.AddXY(49, 1)
.AddXY(50, 1)
.AddXY(51, 1)
.AddXY(52, 1)
.AddXY(53, 1)
End With
End With
'MAKE ONTIME CHART
'______________________________________________________________________________()
'TO CLEAR CHART AND RELOAD IT
Chart2.Titles.Clear()
Chart2.Series.Clear()
Chart2.ChartAreas.Clear()
Chart2.ChartAreas.Add("AREA")
Chart2.Series.Add("WeeklyEfficiency")
Chart2.Series.Add("TARGET")
Chart2.Titles.Add("ON TIME EFFICIENCY")
With Chart2.Titles(0)
.Font = New Font("TAHOMA", 12, FontStyle.Bold)
End With
With Chart2.ChartAreas(0)
'.AxisY.MajorGrid.Enabled = False
.AxisX.MajorGrid.Enabled = False
.AxisX.Title = "WEEKS"
.AxisY.Title = "EFFICIENCY"
.AxisX.Minimum = 0
.AxisX.Maximum = 53
.AxisY.Minimum = 0
.AxisX.Interval = 1
.AxisY.LabelStyle.Format = Format(0, "0%")
End With
With Chart2.Series(0)
.Font = New Font(Me.Font.Name, 7, FontStyle.Regular)
.SmartLabelStyle.Enabled = False
.LabelAngle = -90
.Label = "#VAL{P}"
.IsValueShownAsLabel = True
.Name = "WeeklyEfficiency"
.ChartType = SeriesChartType.Column
.LabelToolTip = Enabled
.ToolTip = "WEEK #VALX" & vbNewLine & "#VAL{P}"
.BorderColor = Color.Black
.LabelForeColor = Color.Transparent
Dim area As String = cbArea.Text
Select Case area
Case "BC_PICKUP"
.Color = Color.Blue
Case "BC_DELIVERY"
.Color = Color.Blue
Case "RAW"
.Color = Color.LimeGreen
Case "RTV"
.Color = Color.Yellow
Case Else
.Color = Color.Black
End Select
'LOAD DATA POINTS
.Points.AddXY(0, 0)
.Points.AddXY(1, lblDeliveryStat1.Text)
.Points.AddXY(2, lblDeliveryStat2.Text)
.Points.AddXY(3, lblDeliveryStat3.Text)
.Points.AddXY(4, lblDeliveryStat4.Text)
.Points.AddXY(5, lblDeliveryStat5.Text)
.Points.AddXY(6, lblDeliveryStat6.Text)
.Points.AddXY(7, lblDeliveryStat7.Text)
.Points.AddXY(8, lblDeliveryStat8.Text)
.Points.AddXY(9, lblDeliveryStat9.Text)
.Points.AddXY(10, lblDeliveryStat10.Text)
.Points.AddXY(11, lblDeliveryStat11.Text)
.Points.AddXY(12, lblDeliveryStat12.Text)
.Points.AddXY(13, lblDeliveryStat13.Text)
.Points.AddXY(14, lblDeliveryStat14.Text)
.Points.AddXY(15, lblDeliveryStat15.Text)
.Points.AddXY(16, lblDeliveryStat16.Text)
.Points.AddXY(17, lblDeliveryStat17.Text)
.Points.AddXY(18, lblDeliveryStat18.Text)
.Points.AddXY(19, lblDeliveryStat19.Text)
.Points.AddXY(20, lblDeliveryStat20.Text)
.Points.AddXY(21, lblDeliveryStat21.Text)
.Points.AddXY(22, lblDeliveryStat22.Text)
.Points.AddXY(23, lblDeliveryStat23.Text)
.Points.AddXY(24, lblDeliveryStat24.Text)
.Points.AddXY(25, lblDeliveryStat25.Text)
.Points.AddXY(26, lblDeliveryStat26.Text)
.Points.AddXY(27, lblDeliveryStat27.Text)
.Points.AddXY(28, lblDeliveryStat28.Text)
.Points.AddXY(29, lblDeliveryStat29.Text)
.Points.AddXY(30, lblDeliveryStat30.Text)
.Points.AddXY(31, lblDeliveryStat33.Text)
.Points.AddXY(32, lblDeliveryStat32.Text)
.Points.AddXY(33, lblDeliveryStat33.Text)
.Points.AddXY(34, lblDeliveryStat34.Text)
.Points.AddXY(35, lblDeliveryStat35.Text)
.Points.AddXY(36, lblDeliveryStat36.Text)
.Points.AddXY(37, lblDeliveryStat37.Text)
.Points.AddXY(38, lblDeliveryStat38.Text)
.Points.AddXY(39, lblDeliveryStat39.Text)
.Points.AddXY(40, lblDeliveryStat40.Text)
.Points.AddXY(41, lblDeliveryStat41.Text)
.Points.AddXY(42, lblDeliveryStat42.Text)
.Points.AddXY(43, lblDeliveryStat43.Text)
.Points.AddXY(44, lblDeliveryStat44.Text)
.Points.AddXY(45, lblDeliveryStat45.Text)
.Points.AddXY(46, lblDeliveryStat46.Text)
.Points.AddXY(47, lblDeliveryStat47.Text)
.Points.AddXY(48, lblDeliveryStat48.Text)
.Points.AddXY(49, lblDeliveryStat49.Text)
.Points.AddXY(50, lblDeliveryStat50.Text)
.Points.AddXY(51, lblDeliveryStat51.Text)
.Points.AddXY(52, lblDeliveryStat52.Text)
.Points.AddXY(53, 0)
End With
With Chart2.Series("TARGET")
.Name = "TARGET"
.ChartType = SeriesChartType.Line
.Color = Color.Red
.BorderWidth = 3
With .Points
.AddXY(0, 1)
.AddXY(1, 1)
.AddXY(2, 1)
.AddXY(3, 1)
.AddXY(4, 1)
.AddXY(5, 1)
.AddXY(6, 1)
.AddXY(7, 1)
.AddXY(8, 1)
.AddXY(9, 1)
.AddXY(10, 1)
.AddXY(11, 1)
.AddXY(12, 1)
.AddXY(13, 1)
.AddXY(14, 1)
.AddXY(15, 1)
.AddXY(16, 1)
.AddXY(17, 1)
.AddXY(18, 1)
.AddXY(19, 1)
.AddXY(20, 1)
.AddXY(21, 1)
.AddXY(22, 1)
.AddXY(23, 1)
.AddXY(24, 1)
.AddXY(25, 1)
.AddXY(26, 1)
.AddXY(27, 1)
.AddXY(28, 1)
.AddXY(29, 1)
.AddXY(30, 1)
.AddXY(31, 1)
.AddXY(32, 1)
.AddXY(33, 1)
.AddXY(34, 1)
.AddXY(35, 1)
.AddXY(36, 1)
.AddXY(37, 1)
.AddXY(38, 1)
.AddXY(39, 1)
.AddXY(40, 1)
.AddXY(41, 1)
.AddXY(42, 1)
.AddXY(43, 1)
.AddXY(44, 1)
.AddXY(45, 1)
.AddXY(46, 1)
.AddXY(47, 1)
.AddXY(48, 1)
.AddXY(49, 1)
.AddXY(50, 1)
.AddXY(51, 1)
.AddXY(52, 1)
.AddXY(53, 1)
End With
End With
End Sub
I had a similar issue with a Caller Id Program I'm developing When the user was bringing back more than a couple of hundred call records it was taking forever
My approach was to only query the DB once at the beginning, Then Use linq on the data Set to bring back in the individual pieces of data
Ian
Private Sub LoadWeeklyStats()
'Get Global DataSource Here
For i As Integer = 0 To 51
Dim LabelWkEff As String = "LblWkEff" + (i + 1).ToString
Dim myArray1 As Array = Controls.Find(LabelWkEff, False)
Dim myControl1 As Label = myArray1(0)
myControl1.Text = RESULT1
'AND
Dim LabelDeliveryStat As String = "lblDeliveryStat" + (i + 1).ToString
Dim myArray2 As Array = Controls.Find(LabelDeliveryStat, False)
Dim myControl2 As Label = myArray2(0)
myControl2.Text = RESULT2
'COUNTER
Week(i + 1)
Next