I'm attempting to populate a 3d array and (at this point) simply return it in msgbox, the data I want in the array is in colums 9, 15 and 16 and would be like...
2342341234, 01/01/1969, 18:00
I keep getting a type mismatch and cannot fathom why, please help if you can, all suggestions welcome as I'm a novice at this stuff
Option Explicit
Global NumberOfRows As Integer
Global FirstRowOfData As Integer
Global LastRowOfData As Integer
Global i As Integer 'row loop
Global HospNo() As Integer
Global TRCDate() As Date
Global TRCTime() As Date
Global MonthArray(HospNo, TRCDate, TRCTime)
Sub CreateMonthArray()
FirstRowOfData = 1
With ActiveSheet
LastRowOfData = Range(.Range("A1"), .Range("A65535").End(xlUp)).Count
End With
Dim MonthArray(HospNo, TRCDate, TRCTime)
For i = FirstRowOfData To NumberOfRows
Let MonthArray(HospNo) = (ActiveSheet.Cells(i + 1, 9).value)
Let MonthArray(TRCDate) = (ActiveSheet.Cells(i + 1, 15).value)
Let MonthArray(TRCTime) = (ActiveSheet.Cells(i + 1, 16).value)
MsgBox MonthArray(HospNo(i), TRCDate(i), TRCTime(i))
Next i
End Sub
Many thanks.
This is not a full discussion of how to create and populate a 3D array of these values, rather just pointing out where your errors are in the code you have presented, which is just creating a single line.
I suspect your error comes on the Global or Dim MonthArray statements. In VBA, Arrays don't have "named" arguments. If that is the issue, you might try something like:
Global MonthArray(0 to 2) as Variant
and then, in your code:
MonthArray(0) = (ActiveSheet.Cells(i + 1, 9).value)
MonthArray(1) = (ActiveSheet.Cells(i + 1, 15).value)
MonthArray(2) = (ActiveSheet.Cells(i + 1, 16).value)
If you want to use Named Arguments (which can be real convenient for debugging, you probably should define a Class object.
In VBA, I usually use Public and not Global; and you should eliminate your duplicate declaration of MonthArray in the body of your code. Also, the Let statement is optional.
You also need to ensure that your NumberOfRows variable is set to a value somewhere. It is not set to anything within this module but, since it is a Public variable, you might be setting it elsewhere.
Finally, your MsgBox statement should be accessing the data in MonthArray by the index number. EG:
MsgBox MonthArray(0) & ", " & MonthArray(1) & "m " & MonthArray(2)
Thank you Ron, I can't tell you how long I spent trying to get that working without humiliating myself here. I'd upvote this if I could... With your notes, the working code is below
Option Explicit
Public NumberOfRows As Integer
Public FirstRowOfData As Integer
Public LastRowOfData As Integer
Public i As Integer 'row loop
'Public HospNo() As Integer
'Public TRCDate() As Date
'Public TRCTime() As Date
Public MonthArray(0 To 2) As Variant
Sub CreateMonthArray()
FirstRowOfData = 1
With ActiveSheet
LastRowOfData = Range(.Range("A1"), .Range("A65535").End(xlUp)).Count
End With
'Dim MonthArray(HospNo, TRCDate, TRCTime)
For i = FirstRowOfData To LastRowOfData
MonthArray(0) = (ActiveSheet.Cells(i + 1, 9).value)
MonthArray(1) = (ActiveSheet.Cells(i + 1, 15).value)
MonthArray(2) = (ActiveSheet.Cells(i + 1, 16).value)
MsgBox MonthArray(0) & ", " & MonthArray(1) & ", " & MonthArray(2)
Next i
End Sub
Related
I am having a very strange problem. I am not able to get the value returned from a simple function as below if the return value is more than one char. Now the second problem is that following code is not assigning "WTH" to sheetName variable. Refer to the screenshot 2. UPDATED AFTER CYRIL'S COMMENTS
Public Sub WTHFormatter()
Dim sheetName As String
sheetName = "WTH"
Dim rng1 As Range
'delete empty rows
lastRowWTH = getLastRow(sheetName, 2)
'Delete rows below the last Row
Worksheets(sheetName).Rows(lastRowWTH + 1 & ":" & Worksheets(sheetName).Rows.Count).Delete
' build first range
Set rng1 = Worksheets(sheetName).Range("B11:F" & lastRowWTH)
Call setCellBorders(rng1)
Set rng1 = Worksheets(sheetName).Range("H11:K" & lastRowWTH)
Call setCellBorders(rng1)
'determine the range for months
For i = 13 To 24
If Cells(7, i) = "" Then
lastCol = i - 1
Exit For
End If
lastCol = i
Next
ColLetter = returnLabel(lastCol)
ColLetter2 = returnLabel(lastCol + 2)
ColLetterX = returnLabel(lastCol + 14)
Set rng1 = Worksheets(sheetName).Range("K17:" & ColLetter & lastRowWTH)
Call setCellBorders(rng1)
Set rng1 = Worksheets(sheetName).Range(ColLetter2 & lastRowWTH & ":" & ColLetter3 & lastRowWTH)
Call setCellBorders(rng1)
End Sub
Function returnLabel(num1 As Long) As String
Dim ColumnLetter As String
ColumnLetter = Split(Cells(1, num1).Address, "$")(1)
returnLabel = ColumnLetter
End Function
The above function returns blank and varTest has nothing after the execution. If I do the line by line execution, I see that test1 in function is not 'Null'.
If I break the execution and probe the variables I see "test1 =" only as per the screen shot below. And this is breaking my code.
Strangely, If I call the function from 'Immediate Window', it returns the expected value.
Things I have already done:
I have tested in a fresh file using simple code as above.
Tested in different PC and the same code is working fine with same version of Windows 10 & Office 365.
Updated / Re-installed MS Office 365
Restarted the PC
If the return value is a single character like "A", the code is working fine.
Failed to understand the reason here. Any help is appreciated.
UPDATE1
I tried it on a fresh file while the code above worked, but the main code is having a new similar problem. This has started happening just now. It's not assigning a string value to the variable. See the attached screenshot.Screenshot of the VBA Code. I am assuming there is some problem with system or some virus.
If the idea is to have a function, that an array, this is possible with the following code:
Function Test1() As Variant
ReDim result(2)
result(0) = "AJ"
result(1) = "A"
Test1 = result
End Function
Sub Main()
Dim varTest As Variant
varTest = Test1(0)
Debug.Print varTest
varTest = Test1(1)
Debug.Print varTest
End Sub
It is questionable why would it be needed, but as a "test-exercise" it is ok.
Going to put my comments into an answer to consolidate and add more explanation.
Pointing out some errors in the code before correcting:
Function test1(num1) 'declare `as variant` to ensure you're returning an array
test1 = "AJ" 'this appears to be saving a single string to var test1
test1 = "A" 'you are now overwriting the above string
End function
Sub test()
varTest = test1(1) 'you have a single string from the function and arrays start at 0, not 1
End sub
You would want to specify the place in the array, after declaring an array, within your function such that:
Function test1() As Variant
Dim arr(2) As Variant 'added array because test1 = BLAH is the final output in a function
arr(0) = "AJ" 'added (1) to call location in array
arr(1) = "A" 'added (2) to call location in array
test1 = arr
End Function
Sub test()
Dim varTest As Variant
varTest = test1(0) 'outputs "AJ" in immediate window
Debug.Print varTest
End Sub
Now you can debug.print your array values, or set to varTest based on the location in the array.
Edit: Tested after my consolidating comments and recognized that there was not an actual output for test1 as an array at the end of the function, so had to go back and add a second array to set test = allowing an array output from a function.
Your code is running as it should.
The test1 function assigns the value AJ to the test1 variable, and then it assigns the value A to the test1 variable.
You could assign the value 50 in your test procedure and it will return A.
I think this is the code you're after:
Function test1(num1) As String
' Dim MyArray As Variant
' MyArray = Array("AJ", "A")
'OR
Dim MyArray(0 To 1)
MyArray(0) = "AJ"
MyArray(1) = "A"
If num1 >= LBound(MyArray) And num1 <= UBound(MyArray) Then
test1 = MyArray(num1)
Else
test1 = "Item not here"
End If
End Function
Sub test()
Dim varTest As String
'Return the second item in the array from the function.
varTest = test1(1)
MsgBox varTest
'Return the first item in the array from the function.
varTest = test1(0)
MsgBox varTest
'Returns "subscript out of range" error as array is only 2 elements in size (0 and 1).
'The error is dealt with in the function using the IF....ELSE...END IF block and returns
'"Item not here" instead.
varTest = test1(2)
MsgBox varTest
End Sub
I solved this by using declaring the variables even when option explicit is not used.
The old code runs without throwing errors even when the variable is not declared and option explicit is also not used. But, for some reasons, it doesn't read / write undeclared variables as expected.
Now as per #cyril suggestion, I declared the variables being used and run the code. This time code ran as expected.
This happened for multiple of variables and at different stages in the code.
I'm quite new to VBA (2 months in) and I'm trying to add three variables to a scripting dictionary in order to reformat an Excel Table and I am running into an error.
I have tried to add three variables by
countrydict.Add country, data, time
But I get an error message
Run-time error '450':
Wrong number of arguments or invalid property assignment
However it works if I write
countrydict.Add country, data 'or
countrydict.Add country, time
Dim lastrow As Long
Dim iter As Long
Dim diter As Long
Dim countrydict As Object
Dim country As String
Dim data As String
Dim time As String
Dim key As Variant
Dim i As Long
Const StartRow As Byte = 2
lastrow = Range("A" & StartRow).End(xlDown).Row
Set countrydict = CreateObject("Scripting.Dictionary")
Dim diter2 As Long, arr, arr2
With ActiveSheet
For iter = 2 To lastrow
country = Trim(.Cells(iter, 1).Value) '<<<<<
data = Trim(.Cells(iter, 2).Value) '<<<<<
time = Trim(.Cells(iter, 3).Text) '<<<<<
If countrydict.Exists(country) Then
If Not InStr(1, countrydict(country), data) > 0 Then
countrydict(country) = countrydict(country) & _
"|" & data & "/" & time
End If
Else
countrydict.Add country, data, time '<<<<<<<
End If
Next
iter = 2
For Each key In countrydict
.Cells(iter, 1).Value = key & ":"
.Cells(iter, 1).Font.Bold = True
.Cells(iter, 1).Font.ColorIndex = 30
iter = iter + 1
arr = Split(countrydict(key), "|")
For diter = 0 To UBound(arr)
arr2 = Split(arr(diter), "/")
.Cells(iter, 1).Value = arr2(0)
.Cells(iter, 2).Value = arr2(1)
Next diter
Next key
End With
End Sub
The expected result is to reformat a table in this format
"A" "B" "C"
EU Sales 10:00
EU Tax 12:00
USA Sales 09:00
USA Tax 10:00
Into this format
EU:
Sales 10:00
Tax 12:00
USA:
Sales 09:00
Tax 10:00
Many thanks for any help. I've been struggeling with this problem for days...
Another possibility is to create a new class to store your data. Store your data in an instance of this class and then pass this object to your dictionary.
This way you could event extend the class to return other stuff, for example all values as a combined string etc... Using public properties you can even set up input validation and what not, but this is probably more than what is needed right now.
I kept the "Class" to the absolute minimum, normally public variables in classes are bad, but since we only use it as custom datatype this does not matter.
Edit: I updatet the class a bit to show some more functionality, but I leave the old one here as an example.
Standard Module "Module1":
Option Explicit
Sub fillDict()
Dim adict As Scripting.Dictionary
Set adict = New Dictionary
Dim info As myRegionData
Dim iter As Long
For iter = 0 To 10
Set info = New myRegionData
info.Region = "someRegion" & iter
info.data = "someData" & iter
info.Time = "someTime" & iter
adict.Add info.Region, info
Next iter
Dim returnInfo As myRegionData
Set returnInfo = adict.Item("someRegion1")
With returnInfo
Debug.Print .Region, .data, .Time 'someRegion1 someData1 someTime1
Debug.Print .fullSentence 'At someTime1 I was in someRegion1 and did someData1
End With
End Sub
Class Module (simple) "myRegionData":
Option Explicit
Public Region As String
Public data As String
Public Time As String
Class Module (extended) "myRegionData":
Option Explicit
Private Type TmyRegionData
'More about this structure:
'https://rubberduckvba.wordpress.com/2018/04/25/private-this-as-tsomething/
Region As String
data As String
Time As String
End Type
Private this As TmyRegionData
Public Property Get Region() As String
Region = this.Region
End Property
Public Property Let Region(value As String)
this.Region = value
End Property
Public Property Get data() As String
data = this.data
End Property
Public Property Let data(value As String)
this.data = value
End Property
Public Property Get Time() As String
Time = this.Time
End Property
Public Property Let Time(value As String)
this.Time = value
End Property
Public Function getFullSentence() As String
getFullSentence = "At " & Time & " I was in " & Region & " and did " & data
End Function
VBA has a dictionary structure. Dictionary is an object, and it can be referenced either with early binding (likeSet countrydict = CreateObject("Scripting.Dictionary")) or with a late binding, referring to Microsoft Scripting Runtime (In VBEditor>Extras>Libraries):
The latter has the advantage, that it is a bit faster and pressing Ctrl+space one would see the Intelli-Sense:
Concerning the question with multiple variables to a dictionary, then an array with those is a possibility:
Sub MyDictionary()
Dim myDict As New Scripting.Dictionary
If Not myDict.Exists("Slim") Then
Debug.Print "Adding Slim"
myDict.Add "Slim", Array("Eminem", "has", "a", "daughter!")
End If
If Not myDict.Exists("Barcelona") Then
Debug.Print "Adding Barcelona"
myDict.Add "Barcelona", Array("I", "have", "been there", 2018)
End If
If Not myDict.Exists("Barcelona") Then
myDict.Add "Barcelona", Array("I", "have", "been there", 2018)
Else
Debug.Print "Barcelona already exists!"
End If
'Keys
Dim key As Variant
For Each key In myDict.Keys
Debug.Print "--------------"
Debug.Print "Key -> "; key
Dim arrItem As Variant
For Each arrItem In myDict(key)
Debug.Print arrItem
Next
Next key
End Sub
This is the result of the code:
Adding Slim
Adding Barcelona
Barcelona already exists!
--------------
Key -> Slim
Eminem
has
a
daughter!
--------------
Key -> Barcelona
I
have
been there
2018
If the value of the dictionary is not an array, e.g. adding somewhere myDict.Add "notArray", 124, an error would pop up once it tries to print the array. This can be avoided with the usage of IsArray built-in function.
I am programming a kind of parser which reads an Excel table and then creates a
List of processes with some properties like Name, StartTime, EndTime etc.
For this I have a class Process and in the main file, I have a processList (Scripting.Dictionary), where I put the processes as I read the lines... For this assignment, the key is a String called MSID.
Now the problem is that for some reason, I am only able to access the Object from the Dictionary and alter its parameters inside one part of my If-ElseIf statement. In the other case, it throws 424-object required error and I have no idea why.
Here is the code
Sub ParseMessages()
' ITERATOR VARIABLES
Dim wb As Workbook, ws As Worksheet
Dim rowIter As Long, row As Variant
Dim A As Variant, B As Variant, C As Variant, D As Variant, E As Variant, F As Variant ' A,B,C,D,E,F variables for the cells of each row
' PROCESS PARAMETERS
Dim MSID As Variant
Dim StartTime As Variant
Dim EndTime As Variant
' OBJECTS
Dim process As process
Dim processList As Scripting.Dictionary ' DICTIONARY where the error happens
Set processList = New Scripting.Dictionary
Worksheets(1).Activate
'####### MAIN LOOP ######################################################
For rowIter = 1 To 11
row = Rows(rowIter)
A = row(1, 1)
B = row(1, 2)
C = row(1, 3)
D = row(1, 4)
E = row(1, 5)
F = row(1, 6)
Dim startIndex As Long, endIndex As Long, count As Long
' ------ PROCESSSTART -> MSID, processName, startTime
If (.....) Then
Debug.Print (vbNewLine & "Process start")
If (...) Then ' --MSID
startIndex = InStr(F, "Nr") + 3 '3 to skip "Nr "
endIndex = InStr(startIndex, F, "(")
count = endIndex - startIndex
MSID = Mid(F, startIndex, count)
StartTime = B
Debug.Print (StartTime & " -> " & MSID)
' **** MAKE new Process object, add to collection
Set process = New process
process.StartTime = StartTime
process.MSID = MSID
processList.Add MSID, process ' Add to the dictionary, KEY, VALUE
ElseIf (...) Then ' --ProcessName
startIndex = InStr(F, "=") + 2
endIndex = InStr(F, "<") - 1
count = endIndex - startIndex
processName = Mid(F, startIndex, count)
Debug.Print (processName)
' **** Add Name to the last element of the dictionary
processList(processList.Keys(processList.count - 1)).Name = processName 'get last Process Object
processList(MSID).Name = "Just Testing" ' !!!! here it works
Else
End If
' ------ END OF PROCESS ->
ElseIf (......) Then
startIndex = InStr(D, "MSID") + 5
endIndex = InStr(startIndex, D, "]")
count = endIndex - startIndex
MSID = Mid(D, startIndex, count)
EndTime = B
Debug.Print (EndTime & " End of process " & MSID)
' **** Add End time for the process from the collection, specified by MSID
Debug.Print ("Test of " & processList(MSID).Name) ' !!!!! Doesn't work
processList(MSID).Name = "Just Prooooooving" ' !!!!! Here doesn't work
processList(MSID).EndTime = EndTime ' !!!!! Does not work
End If
Next
End Sub
So to specify the question - why is it that this works:
processList(MSID).Name = "Just Testing" ' !!!! here it works
And this doesn't:
processList(MSID).Name = "Just Prooooooving" ' !!!!! Here doesn't work
If I first prove if the Object with the MSID key exists in the dictionary,
it's not found.
If processList.Exists(MSID) Then
Debug.Print ("Process exists, altering it...")
processList(MSID).Name = "Just Prooooooving" ' !!!!! Here doesn't work
processList(MSID).EndTime = EndTime
End If
But on the very first line where the condition is evaluated, I get something different by debug. It's THERE! See picture below
Debugging - MSID there but not able to access Dictionary entry with this as a key
Can you suggest how to solve this issue?
Thank you very much in advance for your help!
So... It's a bit shameful but after some hours of trying to solve this problem I found out,
that I added the Object to the list with MSID="124 " as Key.
When I tried to access, I of course used MSID with value "124".
Notice the difference? Yes, that space at the end.
The tricky part is - VBA debugger trims spaces at the end of Strings,
so it's actually impossible to see it. The same situation is if you print this out - impossible to see...
So in the end, I spent many hours looking for the answer, which is so simple :/
All I can do is to laugh about this.
I have a user defined function I would like a sub to use. The UDF works fine, but I need the process to be dynamic; so really I need a sub that will pass two arguments in to my UDF. I keep getting an "object required" error when I try to run the sub. Below is the code for the sub:
Sub pbPeriod()
Dim outF As Long
Dim inF As Range
Set outF = Range("InvestmentOutlay").Value
Set inF = Range(Range("B55"), Range("B55").End(xlToRight))
Range("PB").Formula = "=PaybackPeriod(" & outF.Address & ", " & inF.Address & ")"
End Sub
When I debug it highlights "Set outF= ", but I'm not sure what is actually happening. I'll post the UDF below, but really it accepts two arguments and is used to find payback period. Any help would be appreciated. Thank you:
Public Function PayBackPeriod(outlay, inflow)
Dim i, yr As Integer
Dim cTotal As Double ' cumulative total
cTotal = 0
For i = 1 To inflow.Count
cTotal = cTotal + inflow.Cells(i).Value
If cTotal = Abs(outlay) Then
PayBackPeriod = i
Exit Function
End If
If cTotal > Abs(outlay) Then
yr = i - 1
cTotal = cTotal - inflow.Cells(i).Value
PayBackPeriod = yr + (Abs(outlay) - (cTotal)) / inflow.Cells(i).Value
Exit Function
End If
Next i
PayBackPeriod = "Not enough return to Payback!!!"
I have a column in a spreadsheet.
The format of the data in each cell is aa-0001-xx.
I need to examine the whole column to find the highest value of the sequence number. this would be the substring from column4 thru column7.
I can find the sequence number using Mid(ActiveWorkbook.Sheets("Sheet1").Range("B2:B2"), 4, 4)
But I need to find the max sequence in the whole column.
I am doing this in VBA.
Any help would be appreciated.
Here is my code so far:
Private Sub CommandButton1_Click()
Dim sQuoteNumber As String
Dim sFileName As String
Dim sPathName As String
Dim checkit As String
'Log the Quote
'First, open the log file and determine the next sequential log number.
sPathName = "C:\Users\Rich\Documents\Bryan\BigProject\"
sFileName = "QuoteLog2016.xlsx"
ControlFile = ActiveWorkbook.Name
Workbooks.Open Filename:=sPathName & sFileName
'Create the new Quote Number
checkit = Mid(ActiveWorkbook.Sheets("Sheet1").Range("B2:B2"), 4, 4) ' This is a temp test line
If Mid(ActiveWorkbook.Sheets("Sheet1").Range("B2:B2"), 4, 4) = "" Then
sQuoteNumber = "16-0001"
Else
'find the biggest number
'Here I was looking to like pass the mid function to a Max function of some sort.
sQuoteNumber = "16-0002"
End If
MsgBox ("The new Quote Number is: " + sQuoteNumber)
'Save the log entry
Workbooks(sFileName).Close
All of the comments made to your answer would work well for you. It's also true that there's no evidence in your code at having attempted something, however rudimentary, and this is why answers to a rather trivial task are not forthcoming for you. Perhaps, in future, have a go at some kind of solution ( even if it feels more guesswork than anything) and people on this site will be much more supportive of you.
To set you on your way, you could make use of the Split() function which converts a String into a String array, separated by a nominated value - in the case of your quotations, you could use "-" as your separator. This might be easier than your Mid function and will deal with the case of different sized quotations.
The code below will get you started but you'd want some error handling in there to test, for example, that each cell splits appropriately or that any cells aren't blank. I'll leave all of that to you.
Option Explicit
Private mLastQuote As Long
Public Sub Test()
Initialise 'call this routine just once at the start of your project
MsgBox GetNextQuote(16) 'use the GetNextQuote() function to get next number
MsgBox GetNextQuote(16)
MsgBox GetNextQuote(16)
End Sub
Private Function GetNextQuote(prefix As Integer) As String
mLastQuote = mLastQuote + 1
GetNextQuote = CStr(prefix) & "-" & _
Format(mLastQuote, "000#")
End Function
Private Sub Initialise()
Const PATH_NAME As String = "C:\Users\Rich\Documents\Bryan\BigProject\"
Const FILE_NAME As String = "QuoteLog2016.xlsx"
Const QUOTE_COL As String = "B"
Dim wb As Workbook
Dim ws As Worksheet
Dim v As Variant
Dim r As Long
Dim parts() As String
Dim num As Long
Application.ScreenUpdating = False
Set wb = Workbooks.Open(PATH_NAME & FILE_NAME, True, True)
Set ws = wb.Worksheets("Sheet1")
'Read quote values into variant array
With ws
v = .Range(.Cells(2, QUOTE_COL), _
.Cells(.Rows.Count, QUOTE_COL).End(xlUp)) _
.Value2
End With
'Find max quote
For r = 1 To UBound(v, 1)
parts = Split(v(r, 1), "-") 'splits quote into 3 parts
num = CLng(parts(1)) 'index (1) is the middle part
If num > mLastQuote Then mLastQuote = num
Next
wb.Close False
Application.ScreenUpdating = True
End Sub