Use of Combobox to populate cell with functions and external links - excel

It is very simple but yet I can't figure it out. Maybe because it cannot be done? Regardless here we go:
I would like to use a combobox that will, when selected, input cells with text values, functions and reference to external cells.
First line of the options would be to have the name populated.
Second line is a formula that would change from course to course.
Third line would provide a cell with a reference to another cell's content from another file. So if multiple course file are used I can have one master file that if I change the content of a cell the change will reflect on all the course file cells that are referring to it once updated.
This is in crude code form what I would like it to perform.
Private Sub ComboBox1_Change()
If Me.ComboBox1.Value = "ITCourse" Then
Worksheets("PARADE STATE").Range("I1").Value = "ITCourse"
Worksheets("Data Base").Range("C1").Value = IF(V9>70,"Prep Week",IF(V9>65,"Week 1",IF(V9>60,"Week 2",IF(V9>55,"Week 3",IF(V9>50,"Week 4",IF(V9>45,"Week 5",IF(V9>40,"Week 6",IF(V9>35,"Week 7",IF(V9>30,"Week 8",IF(V9>25,"Week 9",IF(V9>20,"Week 10",IF(V9>15,"Week 11",IF(V9>10,"Week 12",IF(V9>5,"Week 13",IF(V9>0,"Week 14")))))))))))))))
Worksheets("Week 1").Range("B2").Value = 'N:\ITcourse\00 - Data Base\[ITcourse.xlsx]Sheet'!$A$3
End If
If Me.ComboBox1.Value = "HRCourse" Then
Worksheets("PARADE STATE").Range("I1").Value = "HRCourse"
Worksheets("Data Base").Range("C1").Value = IF(V9>40,"Prep Week",IF(V9>35,"Week 1",IF(V9>30,"Week 2",IF(V9>25,"Week 3",IF(V9>20,"Week 4",IF(V9>15,"Week 5",IF(V9>10,"Week 6",IF(V9>5,"Week 7",IF(V9>5,"Week 8")))))))))
Worksheets("Week 1").Range("B2").Value = 'N:\ITcourse\00 - Data Base\[HRcourse.xlsx]Sheet'!$A$3
End If
End Sub
Thank you!

You need a function that returns the number of weeks for any given course name. This function should use a Dictionary to store the information, and the dictionary may be loaded from a dedicated worksheet.
Function WeeksPerCourse(courseName As String) As Long
Static dict As Scripting.Dictionary
If dict Is Nothing Then
' Fill the dictionary here. Note that it is better
' to load the values from a dedicated, hidden worksheet
Set dict = CreateObject("Scripting.Dictionary")
dict("ITCourse") = 14
dict("HRCourse") = 8
' Etc...
End If
WeeksPerCourse = dict(courseName)
End Function
With this function available, your procedure can be simplified like follows:
Private Sub ComboBox1_Change()
Dim course As Sting: course = Trim(ComboBox1.value)
Worksheets("PARADE STATE").Range("I1").value = course
'Dim nWeek As Long
'nWeek = WeeksPerCourse(course) - Worksheets("PARADE STATE").Range("V9").value / 5
'Worksheets("Data Base").Range("C1").value = IIf(nWeek < 1, "Prep Week", "Week " & nWeek)
Worksheets("Data Base").Range("C1").Formula = "= ""Week "" & INT((WeeksPerCourse('PARADE STATE'!I1) - 'PARADE STATE'!V9)/5)"
Worksheets("Week 1").Range("B2").Formula= "='N:\ITcourse\00 - Data Base\[" & course & ".xlsx]Sheet'!$A$3"
End Sub

Related

How to reduce IF statements for multiple option buttons

I have a UserForm which lets the user input a count of product defects into a textbox. This is done as part of monthly reporting, so I have option buttons to select the Month (12 options). There are also option buttons for selecting Product Type. The code basically evaluates what options are selected and copies the textbox values (defect counts) into specific cells in another spreadsheet (for reporting purposes). Not all TextBoxes are required to have values entered by the User.
You can check out a screenshot of the UserForm https://imgur.com/a/6QefjCp.
As you can see from the code, I'm using a bunch of IF statements to perform the decision making - I would like to reduce the length of this code, but I don't know where to start.
I have never really used VBA prior to this, so haven't really attempted a solution. In its current state, the code works flawlessly. Just looking to reduce and clean-up.
Private Sub OKButton_Click() 'This is the button the user clicks to finalize
'the data entry
'Calling the Product type modules
Call Product1Module
Call Product2Module
Call Product3Module
End Sub
Sub Product1Module() 'All product modules will look almost exactly like this
'except the cell ranges will be different
If UserForm.Product1Button.Value = True Then 'Checking for Product1 Option button
If UserForm.JANButton.Value = True Then
'Record value to textbox if JAN is selected
Sheets("Sheet1").Range("B1107").Value = UserForm.TextBox1.Value
Sheets("Sheet1").Range("B1115").Value = UserForm.TextBox2.Value
Sheets("Sheet1").Range("B1108").Value = UserForm.TextBox3.Value
Sheets("Sheet1").Range("B1116").Value = UserForm.TextBox4.Value
Sheets("Sheet1").Range("B1109").Value = UserForm.TextBox5.Value
Sheets("Sheet1").Range("B1117").Value = UserForm.TextBox6.Value
Sheets("Sheet1").Range("B1111").Value = UserForm.TextBox7.Value
ElseIf UserForm.FEBButton.Value = True Then
Sheets("Sheet1").Range("C1107").Value = UserForm.TextBox1.Value
Sheets("Sheet1").Range("C1115").Value = UserForm.TextBox2.Value
Sheets("Sheet1").Range("C1108").Value = UserForm.TextBox3.Value
Sheets("Sheet1").Range("C1116").Value = UserForm.TextBox4.Value
Sheets("Sheet1").Range("C1109").Value = UserForm.TextBox5.Value
Sheets("Sheet1").Range("C1117").Value = UserForm.TextBox6.Value
Sheets("Sheet1").Range("C1111").Value = UserForm.TextBox7.Value
...
End If
End If
End Sub
Give each of your option buttons a Tag property value - e.g. make JANButton.Tag be "B", then make FeBButton.Tag be "C", etc.
Then you can do this:
Dim targetColumn As String
Select Case True
Case UserForm.JANButton
targetColumn = UserForm.JANButton.Tag
Case UserForm.FEBButton
targetColumn = UserForm.FEBButton.Tag
'...
End Select
With Worksheets("Sheet1") '<~ which workbook is that in? whatever is active?
.Range(targetColumn & "1107").Value = UserForm.TextBox1.Value
.Range(targetColumn & "1115").Value = UserForm.TextBox2.Value
'...
End With

VBA - Adding Counter For Tracking

New to writing code in VBA, and I need to add in a way to count/track how often a macro is used. I'm struggling to find any examples of a code that would perform this function. Requesting any examples there might be for this.
Excel VBA doesn't have any built-in storage that persists across sessions - when the application is closed, all variables are released. However you do have a readily available source of storage - the workbook itself. Here's one way to do it:
Make a worksheet called Counter (or something). Optionally, hide it so no one messes with it. Then, when your macro runs, increment the value of Cell(1,1), which will hold your counter value.
Dim runCount As Integer
Dim counterWS As Worksheet
Set counterWS = ThisWorkbook.Worksheets("Counter")
If counterWS.Cells(1,1) <> vbNullString And IsNumeric(counterWS.Cells(1,1)) Then
runCount = counterWS.Cells(1,1) + 1
Else
runCount = 1
End If
counterWS.Cells(1,1) = runCount
Use static when declaring your variable.
From "EXCEL" Ytics:
Can we declare a variable to retain its value from a previous run?
Static Declaration within a procedure limits the variable to that procedure – but helps retain values of variables from previous runs, until forcefully reinitialized by explicit declaration using ‘ReDim’ or value setting.
Sub MySub( )
Static Cnt As Integer
Dim Msg As String
Cnt = Cnt + 1
Msg = “You’ve run the procedure ” & Cnt & ” times”
MsgBox Msg
End Sub
This will build a table for you on a hidden sheet showing all historical uses of the macro up to the nth time the macro was used along with a time stamp so you know when the macro was used. With this, you can use equations to extract exact data that you want as well. If you want a cell to show usage count, just to "Countif("A:A","*")-1” ... (minus 1 to ignore the header in A1)
To Implement this macro:
Create a new sheet titled "MacroCount"
Set A1 = "Instance"
Set B1 = "Time Stamp"
I would personally make this the last thing the macro does so it will only count the instance once the macro completes all of its assigned duties.
Also, Remove the "Sub MacroCount()" & "End Sub" from the below code.
Sub MacroCount()
Dim WS As Worksheet
Set WS = ThisWorkbook.Sheets("MacroCount")
Application.Screenupdating = False
WS.Visible = True
Dim LRow As Long
LRow = WS.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
WS.Range("A" & LRow).Value = LRow - 1
WS.Range("B" & LRow).Value = Now()
WS.Visible = False
Application.Screenupdating = True
End Sub

How to target a specific shape in excel sheet

Program: Excel 2016.
I have a sheet with a lot of shapes. Each of them has its own specific name and most of them are label. I want to change their caption property, but i can't find a way but calling them one by one like this:
LblLabel_1.Caption = ...
LblLabel_2.Caption = ...
LblLabel_3.Caption = ...
Instead i was looking for something like this:
For BytCounter01 = 1 to 255
Shapes("LblLabel_" & BytCounter01).Caption = ...
Next
This one will result in error 438, basically saying Caption is not avaiable for this object. It still target the object, since this code:
Debug.print Shapes("LblLabel_" & BytCounter01).Name
will return me its name.
Looking for a solution:
-i've tried Controls("LblLabel_" & BytCounter01) instead of Shapes("LblLabel_" & BytCounter01) but it won't work since Controls is only for userforms, not for sheets;
-i've tried Shapes("LblLabel_" & BytCounter01).TextFrame.Characters.Text but it returns error 438 again;
-since the label is a part of a group, i've tried both
Shapes("ShpGroupOfShapes01").GroupItems(ShpShapeIndex).Caption
and
Shapes("ShpGroupOfShapes01").GroupItems(ShpShapeIndex).TextFrame.Characters.Text
but got 438 again.
Is there really no way to easily target a specific label on a sheet and change his caption?
Thank you.
EDIT: thanks to Excelosaurus, the problem is solved. Since my labels are ActiveX Controls i have to use something like this:
For BytCounter01 = 1 to 255
Shapes("LblLabel_" & BytCounter01)OLEFormat.Object.Object.Capti‌​on = ...
Next
You can check his response and comments for more details. Thanks again Excelosaurus!
To change the textual content of a shape, use .TextFrame2.TextRange.Text as shown below:
shtShapes.Shapes(sShapeName).TextFrame2.TextRange.Text = sShapeCaption
where shtShapes is the name of your worksheet's object as seen from the Visual Basic Editor in the Project Explorer,
sShapeName is a string variable containing the name of the target shape, and
sShapeCaptionis a string variable containing the desired caption.
A code example follows. I've thrown in a function to check for a shape's existence on a worksheet, by name.
Option Explicit
Public Sub SetLabelCaptions()
Dim bCounter As Byte
Dim sShapeName As String
Dim sShapeCaption As String
For bCounter = 1 To 255
sShapeName = "LblLabel_" & CStr(bCounter)
If ShapeExists(shtMyShapes, sShapeName) Then
sShapeCaption = "Hello World " & CStr(bCounter)
shtMyShapes.Shapes(sShapeName).TextFrame2.TextRange.Text = sShapeCaption
Else
Exit For
End If
Next
End Sub
Public Function ShapeExists(ByVal pshtHost As Excel.Worksheet, ByVal psShapeName As String) As Boolean
Dim boolResult As Boolean
Dim shpTest As Excel.Shape
On Error Resume Next
Set shpTest = pshtHost.Shapes(psShapeName)
boolResult = (Not shpTest Is Nothing)
Set shpTest = Nothing
ShapeExists = boolResult
End Function
The result should look like this:
You can't assign a Caption to a Shape. (Shapes don't have Captions). One approach is to loop over the Shapes and build a little table to tell you what to loop over next:
Sub WhatDoIHave()
Dim kolumn As String, s As Shape
Dim i As Long, r As Range
kolumn = "Z"
i = 1
For Each s In ActiveSheet.Shapes
Set r = Cells(i, kolumn)
r.Value = i
r.Offset(, 1).Value = s.Name
r.Offset(, 2).Value = s.Type
r.Offset(, 3).Value = s.TopLeftCell.Address(0, 0)
i = i + 1
Next s
End Sub
Which for my sample produced:
Seeing that I have both Forms and ActiveX (OLE) Controls, I know what to loop over next. I then refer to the Control by number and assign a Caption if appropriate.

Getting "Expected =" when using Range().Replace()

I'm trying to create a dynamic workbook where I have two Workbooks: one that contains my VB code, and a second containing the Sheets.
As they drop down regions it will update the value depending on the Regions, then update the rest of the Cells.
Sub Retrieve_Sales()
Dim OldRegin As String // Range [support_NP_E10_T12_CP1a_T12-Regions.xlsx]Region 1'!$B$2
Dim NewRegion As String // drop down with Regions 1 - Regions 20
OldRegion = Range("F2").Select
NewRegion = Range("C4").Select
Application.StatusBar = "Retrieing data on" & NewRegion
Application.ScreenUpdating = False
Range("F2").Replace(OldRegion, NewRegion)
End Sub
I keep receiving Expected =. Am I suppose to wrap it to a variable?
You might have several issues.
First, for the Expected = message change the .Replace line to:
Range("F2").Replace OldRegion, NewRegion
For more details, see the answer here: https://stackoverflow.com/a/15519085/2258
Also, I expected you want the .Value of the Range, not the .Select
OldRegion = Range("F2").Value
NewRegion = Range("C4").Value

How to dynamically obtain numeric part of userform control name - VBA

I have 2 small lists of combo boxes. The first list is labled Type(1-5). The second list is labled Products(1-5). I want to populate each PRODUCT box pending on the selection made in the corresponding TYPE box. I am currently doing the following...
Private Sub Type1_Change()
NavComboPropChange
End Sub
Sub NavComboPropChange()
If BaseActiveControl.Name = "AVM" Then
= Worksheets("Setup").Range("AVM").Value
ElseIf BaseActiveControl.Name = "Appraisal" Then
= Worksheets("Setup").Range("APPRAISAL").Value
Else
= Worksheets("Setup").Range("TITLES").Value
End If
End Sub
BaseActiveControl.name grabs the root control element currently selected. Before the equal sign in the IF, ElseIf, Else sequence would be the product name and the corresponding value.
To restate my question though, I want to know how I can grab the numeric part of the control name to use in conjunction with the product box name.
I found the solution using this route.
Sub NavComboPropChange()
Dim myString As String
myString = Right(BaseActiveControl.Name, Len(BaseActiveControl.Name) - 4)
If BaseActiveControl.Value = "AVM" Then
Controls("Products" & myString).List = Worksheets("Setup").Range("AVM").Value
ElseIf BaseActiveControl.Value = "Appraisal" Then
Controls("Products" & myString).List = Worksheets("Setup").Range("APPRAISAL").Value
Else
Controls("Products" & myString).List = Worksheets("Setup").Range("TITLES").Value
End If
End Sub

Resources