Used this code successfully to create range of dynamically constructed variable names. Works really well but unfortunately it closes the calling userform unless the userform is loaded modally (but it needs to be opened modelessly so user can also access the sheet) and no amount of reloading the form works in actually reloading the form.
Have tried hiding and unloading the form and then reloading it modelessly but it doesnt reload.
Excel VBA: Dynamic Variable Name
Option Explicit
Private Const SourceQueryString As String = "myValue1=Dave&someOtherValue=Hockey&HockeyDate=Yesterday"
Sub Test()
Dim queryStringVariablesComponent As VBIDE.vbComponent
Dim queryStringVariablesModule As VBIDE.CodeModule
Dim codeText As String
Dim lineNum As Long: lineNum = 1
Dim lineCount As Long
Set queryStringVariablesComponent = ThisWorkbook.VBProject.VBComponents("QueryStringVariables")
Set queryStringVariablesModule = queryStringVariablesComponent.CodeModule
queryStringVariablesModule.DeleteLines 1, queryStringVariablesModule.CountOfLines
Dim parts
parts = Split(SourceQueryString, "&")
Dim part, variableName, variableValue
For Each part In parts
variableName = Split(part, "=")(0)
variableValue = Split(part, "=")(1)
codeText = "Public Property Get " & variableName & "() As String"
queryStringVariablesModule.InsertLines lineNum, codeText
lineNum = lineNum + 1
codeText = variableName & " = """ & variableValue & ""
queryStringVariablesModule.InsertLines lineNum, codeText
lineNum = lineNum + 1
codeText = "End Property"
queryStringVariablesModule.InsertLines lineNum, codeText
lineNum = lineNum + 1
Next
DisplayIt
End Sub
Sub DisplayIt()
MsgBox myValue1 'Should output "Dave"
End Sub
Row 2 – Column header fields which differ according to user selected header used to construct variable names
Final Solution
Updated final solution
Scoping names to sheet (sheet(“H”), rather than workbook, so that they can be referenced for deletion.
Names Creation
For Each HeaderCell In HeaderRange
HeaderName = Replace(HeaderCell.value, " ", "_")
ThisWorkbook.Worksheets("H").Names.Add Name:=HeaderName, RefersTo:=HeaderCell
Next
Names Deletion
For Each nName In Names
If nName.Parent.Name = "H" Then nName.Delete
Next nName
Names Range referencing
Only slight annoyance is because the names are scoped to sheet rather than to workbook, the need to have to include a reference to the sheet whenever the range is used – Range(“H!A_TEAM”).
But scoping the Names to a dedicated sheet is the only way I can see to identify them for deletion without deleting all the names ranges where the other ones are permanent.
Range("H!A_TEAM").Column
How to reopen a Userform as Modeless after modifying a Module’s code.
The issue that you are have stems from using the Userform’s Default Instance. It would be best to write a subroutine (“Sub ShowUserform()” to create an instance of the Userform.
Sub ShowUserform() Dim MyUserForm1 As New UserForm1 UserForm1.Show False End Sub
Adding ↓this code↓ to the the last line of code that updates the QueryStringVariables
module will re-show the Userform Modeless after 1 second.
Application.OnTime Now + TimeSerial(0, 0, 1), "ShowUserform"
Alternately, you could Unload
the Default Instance before showing it again.
Unload UserForm1 UserForm1.Show
Answer:
I will address the the OP’s question which seems to be “How to create a Modeless Userform at runtime” later tonight. Right now I want to clear up this misconception about using a Dictionary to return a Cell reference versus using Range()
or Cells()
to return the reference.
OP Comment
As I say it’s kinda what I have been doing except at a worksheet range level rather than collection level. It’s just less clean and efficient that’s all. Why run all round the neighbourhood checking house to house when you can just go straight to a known address directly.
Cells and Range Objects store references to the cells in a VBA Collection which can be looked up by their cell address. A Dictionary can also store a collection of references to cell objects which can be looked up by their cell address.
So if Cells, Ranges, a VBA Collection and a Dictionary are all collections which is the fastest? Here are the results of looking up 1000 cells 1000 times using the code below:
Notice that the Dictionary was by far the fastest followed by a VBA Collection, followed by Cells and the Range object came in last. So how can this be? At the surface this might seem counterintuitive but if you think about it you realize that the Cells collection and Ranges are cross sections of all the cells on a worksheet (17,179,869,184) cells. The Cells collection is fairly simple because all the cells in are part of the same cell block. The Cells just resolve the parent, create a new cells collection and return the reference. The Range is considerably more complex because it supports multi-areas and I believe that is why it performed so much slower. Both the Dictionary and the VBA collection are less complicated. You give them an address and they go straight to the stored Cell reference. They don’t have to go around checking the neighbors to see if they are going to be included in the block party.
Cell, Cells, and Range Definition
Represents a single table cell. The Cell object is a member of the Cells collection. The Cells collection represents all the cells in the specified object.
MSDN – Cells Collection Object
Use the Cells property to return the Cells collection.
Represents a cell, a row, a column, a selection of cells containing one or more contiguous blocks of cells, or a 3-D range.
Option Explicit
'
' COPYRIGHT ? DECISION MODELS LIMITED 2006. All rights reserved
' May be redistributed for free but
' may not be sold without the author's explicit permission.
'
Private Declare Function getFrequency Lib "kernel32" Alias _
"QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function getTickCount Lib "kernel32" Alias _
"QueryPerformanceCounter" (cyTickCount As Currency) As Long
Private Const sCPURegKey = "HARDWARE\DESCRIPTION\System\CentralProcessorOption Explicit ' ' COPYRIGHT ? DECISION MODELS LIMITED 2006. All rights reserved ' May be redistributed for free but ' may not be sold without the author's explicit permission. ' Private Declare Function getFrequency Lib "kernel32" Alias _ "QueryPerformanceFrequency" (cyFrequency As Currency) As Long Private Declare Function getTickCount Lib "kernel32" Alias _ "QueryPerformanceCounter" (cyTickCount As Currency) As Long Private Const sCPURegKey = "HARDWARE\DESCRIPTION\System\CentralProcessor\0" Private Const HKEY_LOCAL_MACHINE As Long = &H80000002 Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long Public Enum ReturnTypes retDictionaryTime retVBACollection retCellsRefTime retRangeRefTime End Enum Function MicroTimer() As Double ' ' returns seconds ' Dim cyTicks1 As Currency Static cyFrequency As Currency ' MicroTimer = 0 If cyFrequency = 0 Then getFrequency cyFrequency ' get ticks/sec getTickCount cyTicks1 ' get ticks If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency ' calc seconds End Function Sub RangeLookupTimer(ReturnType As ReturnTypes) Const CELL_COUNT As Long = 1000 Dim cell As Range Dim n As Long, repeats As Long, Result1 As Double, TimeOf As Double Dim dic As Object TimeOf = MicroTimer If ReturnType = retDictionaryTime Then Set dic = CreateObject("Scripting.Dictionary") For Each cell In Sheet1.Range("A1").Resize(CELL_COUNT) Set dic(cell.Address(0, 0)) = cell Next For repeats = 1 To 1000 For n = 1 To CELL_COUNT Call TypeName(dic("A" & n)) Next Next ElseIf ReturnType = retCellsRefTime Then For repeats = 1 To 1000 For n = 1 To CELL_COUNT Call TypeName(Sheet1.Cells(n, "A")) Next Next ElseIf ReturnType = retRangeRefTime Then For repeats = 1 To 1000 For n = 1 To CELL_COUNT Call TypeName(Sheet1.Range("A" & n)) Next Next ElseIf ReturnType = retVBACollection Then Dim colCells As New Collection For Each cell In Sheet1.Range("A1").Resize(CELL_COUNT) colCells.Add Item:=cell, Key:=cell.Address(0, 0) Next For repeats = 1 To 1000 For n = 1 To CELL_COUNT Call TypeName(colCells("A" & n)) Next Next End If Result1 = MicroTimer - TimeOf Debug.Print Round(Result1, 2) End Sub
"
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Public Enum ReturnTypes
retDictionaryTime
retVBACollection
retCellsRefTime
retRangeRefTime
End Enum
Function MicroTimer() As Double
'
' returns seconds
'
Dim cyTicks1 As Currency
Static cyFrequency As Currency
'
MicroTimer = 0
If cyFrequency = 0 Then getFrequency cyFrequency ' get ticks/sec
getTickCount cyTicks1 ' get ticks
If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency ' calc seconds
End Function
Sub RangeLookupTimer(ReturnType As ReturnTypes)
Const CELL_COUNT As Long = 1000
Dim cell As Range
Dim n As Long, repeats As Long, Result1 As Double, TimeOf As Double
Dim dic As Object
TimeOf = MicroTimer
If ReturnType = retDictionaryTime Then
Set dic = CreateObject("Scripting.Dictionary")
For Each cell In Sheet1.Range("A1").Resize(CELL_COUNT)
Set dic(cell.Address(0, 0)) = cell
Next
For repeats = 1 To 1000
For n = 1 To CELL_COUNT
Call TypeName(dic("A" & n))
Next
Next
ElseIf ReturnType = retCellsRefTime Then
For repeats = 1 To 1000
For n = 1 To CELL_COUNT
Call TypeName(Sheet1.Cells(n, "A"))
Next
Next
ElseIf ReturnType = retRangeRefTime Then
For repeats = 1 To 1000
For n = 1 To CELL_COUNT
Call TypeName(Sheet1.Range("A" & n))
Next
Next
ElseIf ReturnType = retVBACollection Then
Dim colCells As New Collection
For Each cell In Sheet1.Range("A1").Resize(CELL_COUNT)
colCells.Add Item:=cell, Key:=cell.Address(0, 0)
Next
For repeats = 1 To 1000
For n = 1 To CELL_COUNT
Call TypeName(colCells("A" & n))
Next
Next
End If
Result1 = MicroTimer - TimeOf
Debug.Print Round(Result1, 2)
End Sub