Home » excel » Excel VBA-Using VBIDE.CodeModule to create dynamic variable names closes userform and will not reload?

Excel VBA-Using VBIDE.CodeModule to create dynamic variable names closes userform and will not reload?

Posted by: admin May 14, 2020 Leave a comment

Questions:

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

enter image description here

Final Solution

enter image description here


Updated final solution

Scoping names to sheet (sheet(“H”), rather than workbook, so that they can be referenced for deletion.

enter image description here

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&Answers:

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:

enter image description here

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

MSDN – Cell Objec

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.

MSDN – Range Object (Excel)

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\CentralProcessor
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\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