Speed up declaring variables? - vba

I have a bunch of Variables I need to declare and was wondering if there's any way to shorten the amount of lines needed to do so. Here's the code:
Sub test()
dim comps as New Collection
dim noOfCompanies as Integer: noOfCompanies = 25
dim c1 as New Names 'Names is a class I have made
dim c2 as New Names
... ' in this gap is c3 to c29
dim c30 as New Names
End Sub
I don't know that you can create a variable and do something like the following, can you? (Note: Psuedocode)
dim i as Integer
for i = 1 to 30
Dim "c" & i as New Names
next i
edit:
#rene mentioned using an array - how would I do so, if later I'm going to set parts of the class properties (sorry, I'm learning classes and don't know the proper terms):
c1.companyCode = 10: c1.companyCountry = "USA": c1.companyName = "Batman LTD"
c2.companyCode = 13: c2.companyCountry = "Krypton": c2.companyName = "Superman LLC"
... 'etc until c30.
Here's what I'm trying so far, but to no avail:
Dim tempC As String, tempN As String
For i = 1 To noOfCompanies
c(i) = "c" & i
tempC = c(i)
Debug.Print tempC 'This will correctly print "c1", "c2", "c3", etc.
Dim c(i) As New Names 'This is where I can't figure out how to declare the different array parts as an individual "new Names" class part.
Debug.Print tempN
Next i
edit2:
Here's why I'm trying to create 30 variables. I get a spreadsheet every week that has a column of codes (the codes being that companyCode I am initializing above). If I find a row with any of the 30 codes I am trying to declare, then I need the companyName and companyCountry to be placed in some other cells on that row. My idea was to be able to just do something like this (psuedocode):
dim rng as Range
rng = Range("A1:A30") 'this has the codes in it, i.e. 13, 10, 11, 20...
for each cel in Rng
'here would be code where I just check for IF the cel.Value is anywhere in companyCode,
'return its equivalent companyCountry and companyName
next cel
So, would a dictionary be best? I could do like
if dict.exists(cel.value)
BUT how could I store the companyCountry and companyName in the same dictionary entry, AFAIK I can only store one key per entry?
...of course, if just saving this info in an excel table somewhere (xlsx or csv) and just opening/using that then closing would be best practice, just let me know!

Dim arrNames(1 to 30) as Names, n
for n=1 to 30
Set arrNames(n)=new Names
next n
arrNames(5).companyCountry = "USA"
EDIT: I think storing your code information on a worksheet and accessing it directly is the "best" approach unless you need high-volume/high-performance lookups (even then it will not be bad...)
For example here's a pretty simple function you can call from VBA:
Function CompanyInfo(companyCode, infoType As String)
Dim rng As Range, colNum As Long, rv
Select Case infoType
Case "Country": colNum = 2
Case "Name": colNum = 3
Case Else
CompanyInfo = "InfoType?"
Exit Function
End Select
rv = Application.VLookup(companyCode, _
ThisWorkbook.Sheets("Codes").Range("A2:C100"), _
colNum, False)
CompanyInfo = IIf(IsError(rv), "???", rv)
End Function
Usage:
Dim v, v2
v = CompanyInfo(10,"Country")
v2 = CompanyInfo(10,"Name")

Example using a collection to create 30 instances of a class containing the name.
If it is imperative that they be able to be retrieved using "c1-c30", then you can either use that as a variable in the class (like Name) or as the collection index/key.
For example:
Names Class:
Private pName As String
Private pOther As Integer
Public Property Get Name() As String
Name = pName
End Property
Public Property Let Name(Value As String)
pName = Value
End Property
Assigning and Printing our 30 Names:
Sub Test()
Dim MyNames As Collection
Set MyNames = New Collection
Dim x
For x = 1 To 30
Dim t As Names
Set t = New Names
t.Name = "c" & x
MyNames.Add t
Next x
Dim y
For Each y In MyNames
MsgBox (y.Name)
Next y
End Sub
In closing, I think your problem is that you want to be able to reference these 30 cnames in your code by name later after having assigned them. That's not going to work and it's a bad coding practice. You shouldn't do:
Dim c1
Set c1 = new Names
c1.Name = "Bob"
Dim c2 '...
There's a reason people don't typically declare 30 variables with incremental numbers. The reason is because there is a better way. That way is typically using a collection of variable types or an array of variable types that you can reference using an index or a loop.
If you're creating 30 instances of a certain data type, and you want to give them each unique values, create a table or even a static array to hold their values and assign them in a loop.
To follow up, if you want to reference them using c & x then add a variable to your class called ID and assign to that.
You might want to look into using a dictionary if you would like to be able to quickly retrieve the ID without looping through and checking ID's.
Edit:
I'm glad you explained your end game. You are absolutely over-complicating this scenario.
A simple VLOOKUP formula and a lookup table would save you from having to code anything in VBA at all.
Example:
Create a named range called LookupTable that contains the company ID's on the far left:
Then, use these formulas to search your table for the ID, and give you the name/location.
Parameter 1 is the value to Lookup
Parameter 2 is our LookupTable
Parameter 3 is the column from our table to return
(1 = ID, 2 = Company Name, 3 = City)
Parameter 4 says we want an exact match only.
=VLOOKUP(A1,LookupTable,2,FALSE)

I'm not sure if I like the use of "Names" as a class name since "Names" already has an Excel VBA meaning, but if that's what you want.
As others have pointed out, an array is probably the way to go. But if you really want to have 30 variables and you don't want to do a lot of typing, you can do something like this:
Sub DeclareVars()
Dim i As Long, v As Variant
ReDim v(1 To 30)
For i = 1 To 30
v(i) = "c" & i & " As New Names"
Next i
Debug.Print "Dim " & Join(v, ", ")
End Sub
Run it once and copy the result from the immediate window into your code. If you know Python you can use a 1-liner in the Python shell and type even less. Just evaluate:
"Dim " + ", ".join('c' + str(i) + " As New Names" for i in range(1,31))

Why don't you store your c1, ... c30 objects properties in a table, an xml file, a csv file, or any other of the multiple types of files? That can store data and be read via VBA.
So, when needed, you can just open the table, and populate an array of your object's properties with the values in the table? If your table/file contains 30 lines, an array of 30 objects will then be created.
By doing this, you will also separate your code from your data, which is usually considered as a best practise.

Related

How to reference similar named textboxes within a loop, with the loop iteration [duplicate]

So I have a table that has a list of totals im trying to display on a form, I have 10 totals I need to get from the totals table and display in 10 textboxes on the form.
The 10 textboxes are "A1, A2, A3..." and its using DLookup to find the ID field number.
It seems like its a syntax issue with Me.TEXTX & X1.Value though I'm not sure how else I can type it.
Hope this makes sense. Thanks!
Private Sub UPDATETOTALS()
Dim FORMX As String
FORMX = "GRID"
Dim TEXTX As String
TEXTX = "A"
Dim TABLENAMEx As String, FINDFIELDx As String, GETFIELDx As String
TABLENAMEx = "GRID_TOTALS"
FINDFIELDx = "[ID]="
GETFIELDx = "TODAY"
Dim X1 As Integer
For X1 = 1 To 10
Me.TEXTX & X1.Value = DLookup(GETFIELDx, TABLENAMEx, FINDFIELDx & X1)
Next X1
End Sub
You cannot access an object reference directly using a concatenated string, as such reference is not of string data type.
Instead, you will need to access the object from the relevant collection (in this case, the Controls collection), by supplying the name of the object (as a string) to the Item method of that collection.
Since the Item method is the default method for a collection, the item name can immediately follow the collection as an argument.
For example:
For X1 = 1 To 10
Me.Controls(TEXTX & X1).Value = DLookup(GETFIELDx, TABLENAMEx, FINDFIELDx & X1)
Next X1

Efficient Data Transfer from Excel VBA to Web-Service

I have a large worksheet (~250K rows, 22 columns, ~40MB plain data) which has to transfer its content to an intranet API. Format does not matter. The problem is: When accessing the data like
Const ROWS = 250000
Const COLS = 22
Dim x As Long, y As Long
Dim myRange As Variant
Dim dummyString As String
Dim sb As New cStringBuilder
myRange = Range(Cells(1, 1), Cells(ROWS, COLS)).Value2
For x = 1 To ROWS
For y = 1 To COLS
dummyString = myRange(x, y) 'Runtime with only this line: 1.8s
sb.Append dummyString 'Runtime with this additional line 163s
Next
Next
I get a wonderful 2D array, but I am not able to collect the data efficiently for HTTP export.
An X/Y loop over the array and access myRange[x, y] has runtimes >1min. I was not able to find an array method which helps to get the imploded/encoded content of the 2D array.
My current workaround is missusing the clipboard (Workaround for Memory Leak when using large string) which works fast, but is a dirty workaround in my eyes AND has one major problem: The values I get are formatted, “.Value” and not “.Value2”, so I have to convert the data on server site again before usage, e.g. unformat currency cells to floats.
What could be another idea to deal with the data array?
My thoughts are that you create two string arrays A and B. A can be of size 1 to ROWS, B can be of size of 1 to COLUMNS. As you loop over each row in your myRange array, fill each element in B with each column's value in that row. After the final column for that row and before you move to the next row, join array B and assign to the row in A. With a loop of this size, only put necessary stuff inside the loop itself. At the end you would join A. You might need to use cstr() when assigning items to B.
Matschek (OP) was able to write the code based on the above, but for anyone else's benefit, the code itself might be something like:
Option Explicit
Private Sub concatenateArrayValues()
Const TOTAL_ROWS As Long = 250000
Const TOTAL_COLUMNS As Long = 22
Dim inputValues As Variant
inputValues = ThisWorkbook.Worksheets("Sheet1").Range("A1").Resize(TOTAL_ROWS, TOTAL_COLUMNS).Value2
' These are static string arrays, as OP's use case involved constants.
Dim outputArray(1 To TOTAL_ROWS) As String ' <- in other words, array A
Dim interimArray(1 To TOTAL_COLUMNS) As String ' <- in other words, array B
Dim rowIndex As Long
Dim columnIndex As Long
' We use constants below when specifying the loop's limits instead of Lbound() and Ubound()
' as OP's use case involved constants.
' If we were using dynamic arrays, we could call Ubound(inputValues,2) once outside of the loop
' And assign the result to a Long type variable
' To avoid calling Ubound() 250k times within the loop itself.
For rowIndex = 1 To TOTAL_ROWS
For columnIndex = 1 To TOTAL_COLUMNS
interimArray(columnIndex) = inputValues(rowIndex, columnIndex)
Next columnIndex
outputArray(rowIndex) = VBA.Strings.Join(interimArray, ",")
Next rowIndex
Dim concatenatedOutput As String
concatenatedOutput = VBA.Strings.Join(outputArray, vbNewLine)
Debug.Print concatenatedOutput
' My current machine isn't particularly great
' but the code above ran and concatenated values in range A1:V250000
' (with each cell containing a random 3-character string) in under 4 seconds.
End Sub

VBA: How do I get unique values in a column and insert it into an array?

I have seen multiple codes regarding this topic but I can't seem to understand it.
For instance, if I have a column that records people names, I want to record all unique names into the array.
So if I have a column of names
David
Johnathan
Peter
Peter
Peter
Louis
David
I want to utilize VBA to extract unique names out of the column and place it into an array so when I call the array it would return these results
Array[0] = David
Array[1] = Johnathan
Array[2] = Peter
Array[3] = Louis
Despite a Collection being mentioned and being a possible solution, it is far more efficient to use a Dictionary as it has an Exists method. Then it's just a matter of adding the names to the dictionary if they don't already exist, and then extracting the keys to an array when you're done.
Note that I've made the name comparisons case-sensitive, but you can change that if necessary, to case-insensitive.
Option Explicit
Sub test()
'Extract all of the names into an array
Dim values As Variant
values = Sheet1.Range("Names").Value2 'Value2 is faster than Value
'Add a reference to Microsoft Scripting Runtime
Dim dic As Scripting.Dictionary
Set dic = New Scripting.Dictionary
'Set the comparison mode to case-sensitive
dic.CompareMode = BinaryCompare
Dim valCounter As Long
For valCounter = LBound(values) To UBound(values)
'Check if the name is already in the dictionary
If Not dic.Exists(values(valCounter, 1)) Then
'Add the new name as a key, along with a dummy value of 0
dic.Add values(valCounter, 1), 0
End If
Next valCounter
'Extract the dictionary's keys as a 1D array
Dim result As Variant
result = dic.Keys
End Sub
use Dictionary object and build a Function that returns your array
Function GetUniqeNames(myRng As Range) As Variant
Dim cell As Range
With CreateObject("Scripting.Dictionary") ' instantiate and reference a Dictionary object
For Each cell In myRng ' loop through passed range
.Item(cell.Value2) = 1 ' store current cell name into referenced dictionary keys (duplicates will be overwritten)
Next
GetUniqeNames = .keys ' write referenced dictionary keys into an array
End With
End Function
that you can exploit in your main code as follows
Sub main()
Dim myArray As Variant
With Worksheets("mysheet") ' change "mysheet" to your actual sheet name
myArray = GetUniqeNames(.Range("A1", .Cells(.Rows.Count, 1).End(xlUp))) ' this will take the referenced sheet column A range from row 1 down to last not empty one
End With
End Sub
Is this a VBA question or a question about programming logic? Use a loop on the column with the data. Check each name against the list of existing data items. If it exists in the list, move on the the next name. If it does not exist in the list, add it.
The "list" is a concept, not a concrete tool. It can be a VBA dictionary, if you are comfortable using that. Or it can be a VBA array, which may not perform as fast as a dictionary, but may be more familiar.
Then again, if you add the data to the Excel Data Model, you can use the Distinct aggregation of a pivot table to list out the unique values.
Without more background it's hard to tell if VBA or Data Model is your best approach. Many VBA solutions get created because people are not aware of Excel's capabilities.
You could use Excel functionality like that.
Sub UniqueNames()
Dim vDat As Variant
Dim rg As Range
Dim i As Long
Set rg = Range("A1:A7")
rg.RemoveDuplicates Columns:=Array(1), Header:=xlNo
With ActiveSheet
vDat = WorksheetFunction.Transpose(.Range("A1:" & .Range("A1").End(xlDown).Address))
End With
For i = LBound(vDat) To UBound(vDat)
Debug.Print vDat(i)
Next i
End Sub
Code is based on your example data, i.e. I put your data into column 1. But the code will also alter the table. If you do not want that you have to use other solutions or put the data beforehand in a temporary sheet.
If you dont want to use "Scripting.Dictionary" and your excel does not have Worksheet.unique(...) like mine
Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
If UBound(arr) >= 0 Then
IsInArray = Not IsError(Application.Match(stringToBeFound, arr, 0))
Else
IsInArray = False
End If
End Function
Public Function GetUniqueValuesFromColumn(ws As Worksheet, sourceColNum As Long, Optional firstRow As Long = 2) As Variant
Dim val As String
Dim i As Long
Dim arr() As Variant
arr = Array()
For i = firstRow To ws.Cells(Rows.Count, sourceColNum).End(xlUp).Row
val = ws.Cells(i, sourceColNum)
If Not IsInArray(val, arr) Then
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr)) = val
End If
Next i
GetUniqueValuesFromColumn = arr
End Function
Then call it like GetUniqueValuesFromColumn(ThisWorkbook.Worksheets("SomeList"), 1)

Excel VBA Error: 1004 Method 'Range' of object '_Worksheet' Failed when Selecting the Range of a Variables Value

My problem:
When trying to Set Table = cSheet.Range(brand_edit) (brand_edit is a variable with the value of a table name) I get Run-time error '1004': Method 'Range' of object '_WorkSheet' failed.
I think it is because I am trying to find the range of a variable's value and I can't think of a way to fix this.
More Info:
I am making a userform that allows the user to grab an Item ID from a Data Sheet in excel and fill a table/item list with the data from the row the Item ID leads.
I have setup a combobox that grabs my table of contents (the Brands) from the Data Sheet (I made it into a table and used the table as the RowSource). I then setup another combobox that displays the Item ID's from the selected Brand. When you select a particular ID I am trying to get it to grab the data from the row in the table that that Item ID leads.
Each Brand has a table tied to it I use some funky replacing to get it to match the table naming scheme. I use these tables as flexible ranges (these tables will change over time so I need to account for that). The item ID's lead the rows and each row has information about the item (cost, description, etc.)
If there are better ways to do any of these things, I am open to ideas.
These are some questions I viewed to try to solve this:
This one introduced me to the code for this and I tried factoring to my use case and I got errors.
Excel VBA - select, get and set data in Table
Public brand_edit As String
Private Sub cmbItemID_Change()
Dim cBook As Workbook
Dim cSheet As Worksheet
Dim ItemID As String
Dim Brand_Table As String
Dim test As String
Dim i As Long
Dim Table As ListObject
Set cBook = ActiveWorkbook
Set cSheet = cBook.Sheets("Gen. Info")
ItemID = cmbItemID.Value
Brand_Table = brand_edit
MsgBox Brand_Table
Set Table = cSheet.Range(brand_edit).Select
For i = 1 To Table.ListRows.Count
If Table.ListColumns(1).DataBodyRange.Rows(i) = ItemID Then
MsgBox ItemID
End If
Next
MsgBox test
End Sub
Public Sub cmbItemID_DropButtonClick()
'funky replacing
Dim brand As String
brand = cmbBrand.Value
brand_edit = Replace(brand, " ", "_")
brand_edit = Replace(brand_edit, """", "")
brand_edit = Replace(brand_edit, "-", "")
brand_edit = Replace(brand_edit, "__", "_")
brand_edit = LCase(brand_edit)
cmbItemID.RowSource = brand_edit
End Sub
There is a better way to Synchronize ComboBoxes! No coding!
Both ComboBoxes have the same dataSetting settings. They set the same value in the shared LinkedCell.
1. BoundColumn
2. LinkedCell
3. ListFillRange
But we change their display setting to give the user a different view.
1. ColumnCount
2. ColumnWidths
3. ListRows
4. ListWidth
You can not directly set a the ListFillRange to a Table. The workaround is to create a Define a Name and set the ListFillRange the new name.
ListFillRange -> Products -> Table1
So I fixed the problem. What was causing it was I was referencing the wrong sheet (aka Gen. Info). How I fixed it was this:
Set dSheet = cBook.Sheets("DATA")
Set Table = dSheet.Range(brand_edit)
Of course once one problem is fixed another one appears. So I am currently working to fix that one.
This post after reading it a number of times (a few last night before posting this and then a couple times this morning) I finnaly got what it was saying and helped me fix this problem. VBA method 'range of object' _Worksheet failed suddenly coming up when running code?
Hopefully this is more useful.
Place getRowSource in a public module. It'll be easier to test and expand.
Public Function getRowSource(brand As String) As String
brand = Replace(brand, " ", "_")
brand = Replace(brand, """", "")
brand = Replace(brand, "-", "")
brand = Replace(brand, "__", "_")
brand = LCase(brand)
getRowSource = brand
End Function
In this way, you can test your rowsource logic in the Immediate Window
If cmbItemID's RowSource is the table that you want to reference then cmbItemID' s ListIndex is it the row that you want to reference.
Dim itemIndex As Long, brand_edit As String
brand_edit = getRowSource(cmbBrand.Value)
itemIndex = cmbItemID.ListIndex
With cSheet.ListObjects(brand_edit)
TextBoxListPrice.Value = DataBodyRange(itemIndex, 1)
TextBoxListCost.Value = DataBodyRange(itemIndex, 2)
TextBoxNotes.Value = DataBodyRange(itemIndex, 3)
TextBoxSpecs.Value = DataBodyRange(itemIndex, 4)
TextBoxDescription.Value = DataBodyRange(itemIndex, 5)
End With

WWBasic + SPSS, script to rename value labels

before I start I want to point out that I tagged this question as VBA because I can't actually make a new tag for Winwrap and I've been told that Winwrap is pretty much the same as VBA.
I'm working on SPSS V19.0 and I'm trying to make a code that will help me identify and assign value labels to all values that don't have a label in the specified variable (or all variables).
The pseudo code below is for the version where it's a single variable (perhaps inputted by a text box or maybe sent via a custom dialogue in the SPSS Stats program (call the .sbs file from the syntax giving it the variable name).
Here is the Pseudo Code:
Sub Main(variable As String)
On Error GoTo bye
'Variable Declaration:
Dim i As Integer, intCount As Integer
Dim strValName As String, strVar As String, strCom As String
Dim varLabels As Variant 'This should be an array of all the value labels in the selected record
Dim objSpssApp As 'No idea what to put here, but I want to select the spss main window.
'Original Idea was to use two loops
'The first loop would fill an array with the value lables and use the index as the value and
'The second loop would check to see which values already had labels and then
'Would ask the user for a value label to apply to each value that didn't.
'loop 1
'For i = 0 To -1
'current = GetObject(variable.valuelist(i)) 'would use this to get the value
'Set varLabels(i) = current
'Next
'Loop for each number in the Value list.
strValName = InputBox("Please specify the variable.")
'Loop for each number in the Value list.
For i = 0 To varLabels-1
If IsEmpty (varLabels(i)) Then
'Find value and ask for the current value label
strVar = InputBox("Please insert Label for value "; varLabels(i);" :","Insert Value Label")
'Apply the response to the required number
strCom = "ADD VALUE LABELS " & strVar & Chr$(39) & intCount & Chr$(39) & Chr$(39) & strValName & Chr$(39) &" ."
'Then the piece of code to execute the Syntax
objSpssApp.ExecuteCommands(strCom, False)
End If
'intCount = intCount + 1 'increase the count so that it shows the correct number
'it's out of the loop so that even filled value labels are counted
'Perhaps this method would be better?
Next
Bye:
End Sub
This is in no way functioning code, it's just basically pseudo code for the process that I want to achieve I'm just looking for some help on it, if you could that would be magic.
Many thanks in advance
Mav
Winwrap and VBA are almost identical with differences that you can find in this post:
http://www.winwrap.com/web/basic/reference/?p=doc_tn0143_technote.htm
I haven't used winwrap, but I'll try to answer with my knowledge from VBA.
Dim varLabels As Variant
You can make an array out of this by saying for example
dim varLabels() as variant 'Dynamically declared array
dim varLabels(10) as variant 'Statically declared array
dim varLabels(1 to 10) as variant 'Array starting from 1 - which I mostly use
dim varLabels(1 to 10, 1 to 3) 'Multidimensional array
Dim objSpssApp As ?
"In theory", you can leave this as a variant type or even do
Dim objSpssApp
Without further declaration, which is basically the same - and it will work because a variant can be anything and will not generate an error. It is good custom though to declare you objects according to an explicit datatype in because the variant type is expensive in terms of memory. You should actually find out about the objects class name, but I cannot give you this. I guess that you should do something like:
set objSpssApp = new <Spss Window>
set objSpssApp = nothing 'In the end to release the object
Code:
'loop 1
For i = 0 To -1
current = GetObject(variable.valuelist(i)) 'would use this to get the value
Set varLabels(i) = current
Next
I don't exactly know why you want to count from 0 to -1 but perhaps it is irrelevant.
To fill an array, you can just do: varLabels(i) = i
The SET statement is used to set objects and you don't need to create an object to create an array. Also note that you did not declare half of the variables used here.
Code:
strVar = InputBox("Please insert Label for value "; varLabels(i);" :","Insert Value Label")
Note that the concatenation operator syntax is &.
This appears to be the same in WinWrap:
http://www.winwrap.com/web/basic/language/?p=doc_operators_oper.htm
But you know this, since you use it in your code.
Code:
'intCount = intCount + 1 'increase the count so that it shows the correct number
'it's out of the loop so that even filled value labels are counted
'Perhaps this method would be better?
I'm not sure if I understand this question, but in theory all loops are valid in any situation, it depends on your preference. For ... Next, Do ... Loop, While ... Wend, in the end they all do basically the same thing. intCount = intCount + 1 seems valid when using it in a loop.
Using Next (for ... next)
When using a counter, always use Next iCounter because it increments the counter.
I hope this reply may be of some use to you!