I have created a UserForm with an empty ComboBox to be populated with a list of formulated (basic concatenate) text for user to select. I got the below code but failed.
Private Sub specList_change()
Dim i As Integer
Dim ListSpec As String
'Clear whatever in listbox
Me.specList.Clear
Me.lineText = ""
Me.partText = ""
'Get none empty data from P6:Pxx
i = 5
Do
DoEvents
i = i + 1
ListSpec = Sheets("SPEC CHART").Range("P" & i)
'Add data into the listbox till all data in SPEC CHART worksheet is empty
If Len(ListSpec) <> 0 Then specList.AddItem (ListSpec)
Loop Until ListSpec = ""
End Sub
Appreciate your guidance.
Use UserForm_Initialize event instead.
Private Sub UserForm_Initialize()
Dim r As Range, lr As Long
With Sheets("SPEC CHART")
lr = .Range("P" & .Rows.Count).End(xlUp).Row
If lr > 5 Then
Set r = .Range("P6:P" & lr)
Me.speclist.RowSource = r.Address(, , , True)
End If
End With
End Sub
Aslo if the source is a Range, you can use RowSource property.
You can also use the List property like this:
Me.speclist.List = Application.Transpose(r)
That is in place of me.speclist.RowSource = r.Address(, , , True). HTH.
Related
I am trying to make an application which lets you update sales condition details using two comboboxes.
See this screenshots for a demo:
1) Datasheet
2) this Userform concerns the creation of a new sales condition
3) a second Userform is required to modify the data and update it in the desired sheet
Regarding my source code for creating a new sales condition, you can find it in here:
Private Sub bAnnuler_Click()
Unload Me
End Sub
Private Sub bEnregistrer_Click()
Sheets("ConditionsVente").Activate
Range("A1").Select
Selection.End(xlDown).Select 'On se positionne sur la derniere ligne non vide
Selection.Offset(1, 0).Select 'On se décale d'une ligne vers le bas
'ActiveCell = txtNom.Value
ActiveCell.Offset(0, 3).Value = txtPrix
ActiveCell.Offset(0, 4).Value = txtDélai
End Sub
Private Sub bReinitialiser_Click()
txtPrix = ""
txtDélai = ""
End Sub
Private Sub cboFournisseur_Change()
End Sub
Private Sub UserForm_Initialize()
'initialiser combobox fournisseur
Dim Fournisseurs As Range
Dim Matieres As Range
Set Fournisseurs = Worksheets("Fournisseurs").Range("A2:A" & Worksheets("Fournisseurs").Range("A2").End(xlDown).Row)
Me.cboFournisseur.MaxLength = Fournisseurs.Count
Me.cboFournisseur.List = Fournisseurs.Value
'initialiser combobox matiere
Set Matieres = Worksheets("Matieres").Range("A2:A" & Worksheets("Matieres").Range("A2").End(xlDown).Row)
Me.cboMatiere.MaxLength = Matieres.Count
Me.cboMatiere.List = Matieres.Value
End Sub
I have two issues:
1) when I run this code, I create a new sales condition but what is saved in the sheet are just the price (prix in french) and the delay (délai in french) and in the columns of Suppliers (Fournisseurs in french) and Raw Material (Matiere in french) are still empty.
2) the second point, in order to make a userform which let me modify the sales condition in the desired sheet, what is the simplest way to realize it ?
For part 1 you need this:
Private Sub bEnregistrer_Click()
Dim nextRow as Integer
With Worksheets("ConditionsVente")
nextRow = .Range("A1").end(xlDown).Row + 1
.Range("A" & nextRow) = txtNom.Value
.Range("B" & nextRow) = txtMatiere.Value
.Range("C" & nextRow) = txtPrix
.Range("D" & nextRow) = txtDélai
End With
End Sub
For part 2 try this:
Private Sub btnSave_Click()
Dim Fournisseurs As Range, Fournisseur as range
Set Fournisseurs = Worksheets("Fournisseurs").Range("A2:A" & Worksheets("Fournisseurs").Range("A2").End(xlDown).Row)
For each Fournisseur in Fournisseurs
If Fournisseur = txtNom.Value And Fournisseur.offset(0, 1) = txtMatiere.Value Then
Fournisseur.offset(0, 3) = txtPrix
Fournisseur.offset(0, 3) = txtDélai
End if
Next Fournisseur
End Sub
I have a spreadsheet that is a data-entry tool for pulling equipment tags and line numbers from engineering drawings – it’s set up with a table that takes either 3-segment tags (columns A-C), 5 segment line numbers (columns A-E), or a list of complete tags (column F), with column G either concatenating the tag segments or pulling across the complete tag. I had this set up using a formula, but I’d rather avoid using complicated formulas in anything that anyone else is going to use and so I took a stab at converting the formula to VBA and putting in a Worksheet_Change procedure.
The code works fine... until you make a change to a cell on the last row of the table and then hit enter or use the down arrow key, at which point Excel crashes. Moving sideways or upwards is fine, and so is moving sideways off the changed cell before hitting enter. I tried converting the table to a regular range, and it still crashes at the last row of the data. I tried turning Application.EnableEvents to False, and that stops the crashing, but then the updating no longer triggers properly.
If the procedure is changed to Worksheet_SelectionChange, it doesn’t crash.
Just to make it more interesting, in both the Worksheet_Change and Worksheet_SelectionChange procedures, using the up/down arrow keys or the enter key fails to trigger a change, but in the Worksheet_SelectionChange procedure arrowing back down/up to the row off which I just moved triggers the update.
I’m sure there are a million ways to fix this, but I have no idea how to do it, and I haven’t had any luck finding an answer.
What I want is for the code to update column G whenever the active cell changes – regardless of whether I use the enter key, tab key, arrow keys, or the $!## mouse to change my cell selection.
I'm working on a Windows 10 machine, using Excel 2016. When I get to work tomorrow I'll see how it goes on Excel 2013.
Spreadsheet screencap, for reference: https://drive.google.com/file/d/0B_wa8YmM1J2ddjlkOWxERE5TM1k/view?usp=sharing
Any assistance would be hugely appreciated - especially if it comes with a thorough explanation about what is going on here.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim strDelim As String
Dim strConcatTag As String
Dim intActiveRow As Integer
Dim rngTagSegment As Range
Dim rngSingleTag As Range
Dim rng3SegmentTag As Range
Dim rng5SegmentTag As Range
Dim rngTagEntry As Range
Dim rngConcatTag As Range
Dim rngCheck As Range
strDelim = "-"
intActiveRow = ActiveCell.Row
Set rngSingleTag = Cells(intActiveRow, 6)
Set rng3SegmentTag = Range(Cells(intActiveRow, 1), Cells(intActiveRow, 3))
Set rng5SegmentTag = Range(Cells(intActiveRow, 1), Cells(intActiveRow, 5))
Set rngTagEntry = Range(Cells(intActiveRow, 1), Cells(intActiveRow, 6))
Set rngConcatTag = Cells(intActiveRow, 7)
If intActiveRow = 1 Then
Exit Sub
Else
Select Case True
Case WorksheetFunction.CountA(rngTagEntry) = 0
rngConcatTag = ""
Case WorksheetFunction.CountA(rng5SegmentTag) > 0 And WorksheetFunction.CountA(rngSingleTag) > 0
rngConcatTag = "Enter either a complete tag or the individual sections, not both"
Case WorksheetFunction.CountA(rng5SegmentTag) = 0 And WorksheetFunction.CountA(rngSingleTag) <> 0
rngConcatTag = UCase(Trim(rngSingleTag))
Case WorksheetFunction.CountA(rng3SegmentTag) = 3 And WorksheetFunction.CountA(rng5SegmentTag) = 3
For Each rngTagSegment In rng5SegmentTag
strConcatTag = IIf(rngTagSegment = "", Trim(strConcatTag) & "", IIf(strConcatTag = "", _
Trim(rngTagSegment.Text), Trim(strConcatTag) & strDelim & Trim(rngTagSegment.Text)))
Next
rngConcatTag = UCase(Trim(strConcatTag))
Case WorksheetFunction.CountA(rng3SegmentTag) = 3 And WorksheetFunction.CountA(rng5SegmentTag) = 5
For Each rngTagSegment In rng5SegmentTag
strConcatTag = IIf(rngTagSegment = "", Trim(strConcatTag) & "", IIf(strConcatTag = "", _
Trim(rngTagSegment.Text), Trim(strConcatTag) & strDelim & Trim(rngTagSegment.Text)))
Next
rngConcatTag = UCase(strConcatTag)
Case Else
rngConcatTag = "Incomplete Tag"
End Select
End If
End Sub
Something like this should work:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rw As Range, r As Range, dataRange As Range
Dim rngSingleTag As Range
Dim rng3SegmentTag As Range
Dim rng5SegmentTag As Range
Dim rngTagEntry As Range
Dim rngConcatTag As Range
'data entry area only (adjust to suit)...
Set dataRange = Application.Intersect(Target, Me.Range("A2:F10000"))
If dataRange Is Nothing Then Exit Sub 'nothing to do...
'process each changed row
For Each r In dataRange.Rows
Set rw = r.EntireRow
Set rngSingleTag = rw.Cells(6)
Set rng3SegmentTag = rw.Cells(1).Resize(1, 3)
Set rng5SegmentTag = rw.Cells(1).Resize(1, 5)
Set rngTagEntry = rw.Cells(1).Resize(1, 6)
Set rngConcatTag = rw.Cells(7)
Select Case True
Case filled(rngTagEntry) = 0
rngConcatTag = ""
Case filled(rng5SegmentTag) > 0 And filled(rngSingleTag) = 1
rngConcatTag = "Enter either a complete tag or the individual sections, not both"
Case filled(rng5SegmentTag) = 0 And filled(rngSingleTag) = 1
rngConcatTag = UCase(Trim(rngSingleTag))
Case filled(rng3SegmentTag) = 3 And filled(rng5SegmentTag) = 3
rngConcatTag = Tag(rng3SegmentTag)
Case filled(rng5SegmentTag) = 5
rngConcatTag = Tag(rng5SegmentTag)
Case Else
rngConcatTag = "Incomplete Tag"
End Select
Next r
End Sub
Function filled(rng)
filled = Application.CountA(rng)
End Function
Function Tag(rng) As String
Const DELIM As String = "-"
Dim c As Range, rv As String
For Each c In rng.Cells
rv = rv & IIf(Len(rv) > 0, DELIM, "") & Trim(c.Text)
Next c
Tag = rv
End Function
I'm making some sort of football database where I would input data using a userform and where I want to retrieve data from my excel database.
I have a worksheet named "wedstrijden".
This worksheet contain the columns: Date, HomeTeam, AwayTeam, HomeScore,AwayScore, HomeOdds and AwayOdds.
My other worksheet is named "ingevenuitslagen".
This worksheet contains my userform called "UitslagenIngeven".
Using the code below I'm able to input my data from the userform to my "wedstrijden" worksheet:
Private Sub putAway_Click()
Dim ingevenuitslagen As Worksheet
Set ingevenuitslagen = ThisWorkbook.Sheets("wedstrijden")
NextRow = ingevenuitslagen.Cells(Rows.Count, 1).End(xlUp).Row + 1
ingevenuitslagen.Cells(NextRow, 1) = CDate(date_txt.Text)
ingevenuitslagen.Cells(NextRow, 2) = UitslagenIngeven.cboHomeTeam
ingevenuitslagen.Cells(NextRow, 3) = UitslagenIngeven.cboAwayTeam
ingevenuitslagen.Cells(NextRow, 4) = UitslagenIngeven.cboHScore
ingevenuitslagen.Cells(NextRow, 5) = UitslagenIngeven.cboAScore
ingevenuitslagen.Cells(NextRow, 6) = Val(UitslagenIngeven.hodds_txt.Text)
ingevenuitslagen.Cells(NextRow, 7) = Val(UitslagenIngeven.aodds_txt.Text)
End Sub
But now I want to return the values of the last row (worksheet "wedstrijden") to my userform using a button called "GetData", but I have no idea how to code that button.
This button will look like a lot with what you already have, something like this :
Private Sub GetData_Click()
Dim wedstrijden As Worksheet
Set wedstrijden = ThisWorkbook.Sheets("wedstrijden")
With wedstrijden
NextRow = .Cells(.Rows.Count, 1).End(xlUp).Row
UitslagenIngeven.date_txt.Text = .Cells(NextRow, 1)
UitslagenIngeven.cboHomeTeam = .Cells(NextRow, 2)
UitslagenIngeven.cboAwayTeam = .Cells(NextRow, 3)
UitslagenIngeven.cboHScore = .Cells(NextRow, 4)
UitslagenIngeven.cboAScore = .Cells(NextRow, 5)
UitslagenIngeven.hodds_txt.Text = .Cells(NextRow, 6)
UitslagenIngeven.aodds_txt.Text = .Cells(NextRow, 7)
End With
End Sub
How to work with a Data Array
Code to place in the UserForm to fill the data array :
Public DataA() 'This line should be at the top of the module
'Code to Set the dimension of the Data array
Private Sub UserForm_Initialize()
'5 is the number of information that you want to store
Dim DataA(5,0)
'----Or
'Take the number of column of your Data Base
Dim DataA(ThisWorkbook.Sheets("DB").Range("A1").End(xlToRight).Column + 1,0)
'Rest of your code
End Sub
'Code to add a data set to the data array
Private Sub CommandButton1_Click()
UnFilter_DB 'See below procedure
DataA(1) = Now()
DataA(2) = Me.Lb_Data.Caption
DataA(3) = Me.Lb_Year.Caption
DataA(4) = Me.Lb_BL.Caption
DataA(5) = Me.Lb_Country
ReDim Preserve DataA(Lbound(DataA,1) To Ubound(DataA,1), Lbound(DataA,2) To Ubound(DataA,2)+1)
End Sub
'Code to sent the data array to the DB
Private Sub CommandButton2_Click()
ReDim Preserve DataA(Lbound(DataA,1) To Ubound(DataA,1), Lbound(DataA,2) To Ubound(DataA,2)-1)
SetData DataA
End Sub
Procedure to print the data array that you pass from the user form :
Public Sub SetData(ByVal Data_Array As Variant)
Dim DestRg As Range, _
A()
'Find the last row of your DataBase
Set DestRg = ThisWorkbook.Sheets("DB").Range("Db_Val").Cells(ThisWorkbook.Sheets("DB").Range("Db_Val").Rows.Count, 1)
'Print your array starting on the next row
DestRg.Offset(1, 0).Resize(UBound(Data_Array, 1), UBound(Data_Array, 2)).Value = Data_Array
'Set Increasing ID
ThisWorkbook.Sheets("DB").Cells(Rows.Count, 1).End(xlUp) = ThisWorkbook.Sheets("DB").Cells(Rows.Count, 1).End(xlUp).Offset(-1, 0) + 1
End Sub
Sub to unfilter the DB you are working with (Here it is the Named Range Db_Val in DB sheet)
Public Sub UnFilter_DB()
'Use before "print" array in sheet to unfilter DB to avoid problems (always writing on the same row if it is still filtered)
Dim ActiveS As String, CurrScreenUpdate As Boolean
CurrScreenUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
ActiveS = ActiveSheet.Name
Sheets("DB").Activate
Sheets("DB").Range("A1").Activate
Sheets("DB").ShowAllData
DoEvents
Sheets(ActiveS).Activate
Application.ScreenUpdating = CurrScreenUpdate
End Sub
What I'm looking to do is comb through a column and pull all the unique identifiers out of that column and then paste the results in a table in a different worksheet. I found the code below and it is very close to what I need. However, I have two major problems with it that I cannot figure out. First the area that this macro searches is constant ie "A1:B50". I need this to be one column and be dynamic since more data and new unique identifiers will be added to this worksheet. Second I cannot figure out how to paste my results to a specific range on a different worksheet. For example if I wanted to take the results and paste them in "sheet2" starting in at "B5" and going to however long the list of unique identifiers is.
Sub ExtractUniqueEntries()
Const ProductSheetName = "Sheet1" ' change as appropriate
Const ProductRange = "B2:B"
Const ResultsCol = "E"
Dim productWS As Worksheet
Dim uniqueList() As String
Dim productsList As Range
Dim anyProduct
Dim LC As Integer
ReDim uniqueList(1 To 1)
Set productWS = Worksheets(ProductSheetName)
Set productsList = productWS.Range(ProductRange)
Application.ScreenUpdating = False
For Each anyProduct In productsList
If Not IsEmpty(anyProduct) Then
If Trim(anyProduct) <> "" Then
For LC = LBound(uniqueList) To UBound(uniqueList)
If Trim(anyProduct) = uniqueList(LC) Then
Exit For ' found match, exit
End If
Next
If LC > UBound(uniqueList) Then
'new item, add it
uniqueList(UBound(uniqueList)) = Trim(anyProduct)
'make room for another
ReDim Preserve uniqueList(1 To UBound(uniqueList) + 1)
End If
End If
End If
Next ' end anyProduct loop
If UBound(uniqueList) > 1 Then
'remove empty element
ReDim Preserve uniqueList(1 To UBound(uniqueList) - 1)
End If
'clear out any previous entries in results column
If productWS.Range(ResultsCol & Rows.Count).End(xlUp).Row > 1 Then
productWS.Range(ResultsCol & 2 & ":" & _
productWS.Range(ResultsCol & Rows.Count).Address).ClearContents
End If
'list the unique items found
For LC = LBound(uniqueList) To UBound(uniqueList)
productWS.Range(ResultsCol & Rows.Count).End(xlUp).Offset(1, 0) = _
uniqueList(LC)
Next
'housekeeping cleanup
Set productsList = Nothing
Set productWS = Nothing
End Sub
I think your solution is a bit more tricky than it needs to be. Collecting unique ids becomes almost trivial is you use a Dictionary instead of a list. The added benefit is that a dictionary will scale much better than a list as your data set becomes larger.
The code below should provide you with a good starting point to get you going. For convenience's sake I used the reference from your post. So output will be on sheet2 to starting in cell B5 going down and the input is assumed to be on sheet1 cell B2 going down.
If you have any questions, please let me know.
Option Explicit
Sub ExtractUniqueEntries()
'enable microsoft scripting runtime --> tools - references
Dim unique_ids As New Dictionary
Dim cursor As Range: Set cursor = ThisWorkbook.Sheets("Sheet1").Range("B2") 'change as Required
'collect the unique ids
'This assumes that:
'1. ids do not contain blank rows.
'2. ids are properly formatted. Should this not be the could you'll need to do some validating.
While Not IsEmpty(cursor)
unique_ids(cursor.Value) = ""
Set cursor = cursor.Offset(RowOffset:=1)
Wend
'output the ids to some target.
'assumes the output area is blank.
Dim target As Range: Set target = ThisWorkbook.Sheets("Sheet2").Range("B5")
Dim id_ As Variant
For Each id_ In unique_ids
target = id_
Set target = target.Offset(RowOffset:=1)
Next id_
End Sub
A small modification will do it; the key is to define the ProductRange.
Sub ExtractUniqueEntries()
Const ProductSheetName = "Sheet1" ' change as appropriate
Dim ProductRange
ProductRange = "B2:B" & Range("B" & Cells.Rows.Count).End(xlUp).Row
Const ResultsCol = "E"
Dim productWS As Worksheet
Dim uniqueList() As String
Dim productsList As Range
Dim anyProduct
Dim LC As Integer
ReDim uniqueList(1 To 1)
Set productWS = Worksheets(ProductSheetName)
Set productsList = productWS.Range(ProductRange)
Application.ScreenUpdating = False
For Each anyProduct In productsList
If Not IsEmpty(anyProduct) Then
If Trim(anyProduct) <> "" Then
For LC = LBound(uniqueList) To UBound(uniqueList)
If Trim(anyProduct) = uniqueList(LC) Then
Exit For ' found match, exit
End If
Next
If LC > UBound(uniqueList) Then
'new item, add it
uniqueList(UBound(uniqueList)) = Trim(anyProduct)
'make room for another
ReDim Preserve uniqueList(1 To UBound(uniqueList) + 1)
End If
End If
End If
Next ' end anyProduct loop
If UBound(uniqueList) > 1 Then
'remove empty element
ReDim Preserve uniqueList(1 To UBound(uniqueList) - 1)
End If
'clear out any previous entries in results column
If productWS.Range(ResultsCol & Rows.Count).End(xlUp).Row > 1 Then
productWS.Range(ResultsCol & 2 & ":" & _
productWS.Range(ResultsCol & Rows.Count).Address).ClearContents
End If
'list the unique items found
For LC = LBound(uniqueList) To UBound(uniqueList)
productWS.Range(ResultsCol & Rows.Count).End(xlUp).Offset(1, 0) = _
uniqueList(LC)
Next
'housekeeping cleanup
Set productsList = Nothing
Set productWS = Nothing
End Sub
I am trying to automate a spreadsheet to transfer data from one sheet to another sheet depending on what the first 3 characters of the data is. So for example, for the data NDX 12/31/2012 P2600, I would like it to be placed in the NDX sheet. So I have an array (desArr()) that splits that data into different positions of the array, such that desArr(0) contains "NDX", desArr(1) contains "12/31/2012" and so on.
The part I am having trouble with is moving the data to the respective sheets. Specifically, I need a variable reference to these spreadsheets. For instant, take the NDX sheet. I know I can just do NDX.cells(1,1).Paste or Worksheets(NDX.Name).Cells(1,1).Paste and that would work, but what if I want to do that for multiple sheets? I could obviously use If statements to define each different instance, but I wanted to shorten my code. Hence, I am trying to make the reference to the sheet objects variable, i.e. desArr(0).Name, but it returns with an error (which I understand why). Anyone with suggestions on how to achieve this? I know one solution is to just use the name property of the worksheet, but I wanted to avoid the chance of my code failing if someone changed the name of the sheets.
So perhaps like:
Dim desArr() As String, desInfo As String, opType As String
Dim rNum As Long, cNum As Long, i As Long
Dim wb As Workbook
Dim ws As Worksheet
Dim sortRng As Range, findRng As Range
Dim j As Integer 'Throw away after testing
Dim test As String 'Throw away after testing
Dim k As Integer 'Throw away after testing
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wb = ThisWorkbook
Set ws = wb.Worksheets(Import.Name)
With ws
rNum = .Range("C1048576").End(xlUp).Row
cNum = 6 'Number of used columns starting from left
Set sortRng = .Range(.Cells(3, 2), .Cells(rNum, cNum))
'Sort range according to Type and Description
sortRng.Sort _
Key1:=.Range("B1"), _
Key2:=.Range("C1")
'Apply conditional formatting
With sortRng.Columns(2)
.FormatConditions.AddUniqueValues
.FormatConditions(.FormatConditions.Count).SetFirstPriority
.FormatConditions(1).DupeUnique = xlDuplicate
With sortRng.Columns(2).FormatConditions(1)
.Interior.PatternColorIndex = xlAutomatic
.Interior.Color = 13551615
.Interior.TintAndShade = 0
.StopIfTrue = False
End With
End With
For i = 0 To (rNum - 2)
With sortRng.Cells(i + 1, 2)
If .DisplayFormat.Interior.Color = "13551615" Then
j = 0
While (.Value = .Offset(j + 1, 0).Value And .Offset(0, 1).Value = .Offset(j + 1, 1).Value)
j = j + 1
Wend
If (j <> 0) Then 'There are duplicates
End If
End If
'Converting the description to format used for classification
If .Offset(0, -1) = "Ext Option" Then
desArr = Split(.Value, " ")
If Not (Left(.Value, 3) = "SX5" Or Left(.Value, 3) = "UKX") Then
'check if it's a call or put
If Left(desArr(3), 1) = "C" Then
opType = "Call"
ElseIf Left(desArr(3), 1) = "P" Then
opType = "Put"
Else
opType = "N/A"
End If
desInfo = Format(desArr(2), "mmmdd") & " " & Right(Trim(desArr(3)), Len(Trim(desArr(3))) - 1) & " " & opType
Else
'check if it's a call or put
If Left(desArr(2), 1) = "C" Then
opType = "Call"
ElseIf Left(desArr(2), 1) = "P" Then
opType = "Put"
Else
opType = "N/A"
End If
desInfo = Format(desArr(1), "mmmdd") & " " & Right(Trim(desArr(2)), Len(Trim(desArr(2))) - 1) & " " & opType
End If
End If
End With
Next i
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Except that NDX would have to be variable as which worksheet to move the data to depends on the data.
You can use the codename property of the worksheets. If you use NDX.Cells(1,1), NDX is the codename of the sheet. simply search all worksheets, e.g.:
Function GetWorksheet(byval withCodename as String) as Worksheet
Dim sheetVar as Worksheet
For each sheetVar in ThisWorkbook.Worksheets
If sheetVar.CodeName = withCodename Then
Set GetWorksheet = sheetVar
End if
Next
End Function
You could:
Prevent user from renaming sheets
You wrote: "I wanted to avoid the chance of my code failing if someone changed the name of the sheets."
Well, the user can't do this:
If you protect the workbook. You can do this manually in the ribbon (Review > Changes > Protect workbook), or programmatically like this:
ThisWorkbook.Protect 'optionally, add a password -- see documentation for Protect
This will entirely prevent the user from changing sheet names.