VBA Excel object required passing string array variable - vba

I am attempting to pass an array of strings into a function as a variable and am getting a '424 Object required' error when I try to compare the values in the array to values in a given cell. I am new to VBA so this may be a simple syntax error but I cannot seem to figure it out. Here's my code:
Method being called:
Sub InitializeCharts()
'Set's up the array for checking data names in the social groups
Dim socialArray As Variant
socialArray = Array("Chores", "Meat & Potatos", "Work", "Wind Down", "Reward")
'...
Call ChartLogic(Range("'ActivityTracker'!B12"), Range("'Groups'!F4"), socialArray)
End Sub
ChartLogic Method:
Sub ChartLogic(dataCell As Range, tableCell As Range, socialArray As Variant)
Dim temp As Double
Dim count As Integer
'...
'Loops through the table and looks for the social cells with the same name, adding them to the chart
Do Until IsEmpty(dataCell)
For count = LBound(socialArray) To UBound(socialArray)
If socialArray(count).Value = dataCell.Value Then '<---Error Here
temp = socialCell.Offset(count, 0).Value
socialCell.Offset(count, 0).Value = temp + dataCell.Offset(0, 4).Value
End If
Next
Set dataCell = dataCell.Offset(1, 0)
Loop
End Sub
Thanks in advance!

You're getting an Object required error because socialArray(count) does not yield an object that has the property Value.
In other words, since socialArray is an Array of strings, socialArray(count) already yields a string—there's no need for Value.

As Andrew pointed out - socialArray(count).Value = will cause an error because it's a variant. You can store it as a local variable like this.
ArrVal = socialArray(count)
For count = LBound(socialArray) To UBound(socialArray)
ArrayVal = socialArray(count)
If ArrayVal = dataCell.Value Then '<---Error Here
temp = socialCell.Offset(count, 0).Value
socialCell.Offset(count, 0).Value = temp + dataCell.Offset(0, 4).Value
End If
Next
Or you could just take off the .value as it's not a cell and is not a worksheet object but a variant.
If socialArray(count) = dataCell.Value Then

Related

Excel VBA - Dynamically supply ranges to Union method

User has defined named ranges to print in Excel.
I am reading these ranges into a VBA array. Is there a way to supply the range names to the Union method to set non-contiguous print ranges.
For example, something like:
ActiveSheet.PageSetup.PrintArea = Union(Range(array(1)), Range(array(2))).Address
The number of ranges held in the array can vary. I've experimented with looping through the array and building a string variable, but no success.
Any help would be appreciated.
You'll have to substitute the actual range names or objects in the statement, but here is how to use the Union function to set a PrintArea:
Sub foo()
Dim setup As PageSetup
Set setup = ActiveSheet.PageSetup
setup.PrintArea = Union(Range("MyRange1"), Range("MyRange2")).Address
End Sub
What I'm actually looking for is a method to construct the Union statement using range names that are held in an array
OK, then use the above method and a custom function to construct the Union in a loop:
Sub foo()
Dim setup As PageSetup
Dim RangeArray(1) As Range
Set setup = ActiveSheet.PageSetup
Set RangeArray(0) = Range("MyRange1")
Set RangeArray(1) = Range("MyRange2")
setup.PrintArea = GetUnion(RangeArray)
End Sub
Function GetUnion(arr As Variant) As String
Dim itm As Variant
Dim ret As Range
For Each itm In arr
If Not ret Is Nothing Then
Set ret = Union(ret, itm)
Else
Set ret = itm
End If
Next
If Not ret Is Nothing Then
GetUnion = ret.Address
Else
GetUnion = "" 'May cause an error...
End If
End Function

Assigning values to 2-dimensional array

I'm trying to get some data I input with another macro into a 2-dimensional array so I can then apply a function to that data, but no matter what I try I keep getting errors. The data includes strings and numbers. I could always just reference the cells and forget about the array, but that complicates the function. Here's my code:
(Declarations)
Dim nLiens As Byte, nCreditors As Byte
Dim SecurityV As Currency, ASecurityV As Currency
Const adjuster = 0.9
(Relevant subs)
Public Sub VariableDeclaration()
nLiens = InputBox("Enter number of liens in security")
nCreditors = InputBox("Enter number of creditors")
SecurityV = InputBox("Enter security full value")
ASecurityV = adjuster * SecurityV
Call ODebt
End Sub
Sub ODebt()
'
'(...)
'
Dim oDebt() As Variant
ReDim oDebt(1 To nCreditors + 1, 1 To nLiens + 1)
Dim rg As Range
Set rg = Range(Cells(1, 1), Cells(nCreditors + 1, nLiens + 1))
oDebt = rg.Value
MsgBox (oDebt)
'>>> ERROR: type mismatch
Call SAllocation
End Sub
I've tried other alternatives, such as setting the content cell by cell with two 'For' loops and LBound and UBound, but nothing seems to work.
You are getting your error not while filling, but at displaying the array.
It is not possible to just Msgbox an array, since Msgbox expects a String argument. You can, in the other hand, display specific positions (e.g. oDebt(1,1)).
If you want to have a look at all of its contents, either use debug mode and the Local window, or print it to some unused cells.
I would copy the values from the datasheet this way:
Dim oDebt As Variant
Dim rg As Range
Set rg = Range(Cells(1, 1), Cells(nCreditors + 1, nLiens + 1))
oDebt = rg ' get data from sheet
'... do calculations with oDebt array
rg = oDebt ' put data on sheet
In words: you dimension the array automatically by assigning the range. If you need the numeric boundaries, use
nrows = UBound(oDebt, 1)
ncols = UBound(oDebt, 2)
Here you see the meaning of the dimension as well, index 1 is rows, index 2 is columns.

Knowing the assigned name of a cell instead of the "A1" name

Context:
I have several lists in my sheet (1 column wide, 1-10 rows long). When I right click a cell in these lists, I can do several options, that all work well. I have given a name to the cell at the top of each of these lists (ex. Cell A1 has been given the name cell_1, B10 is names cell_2, etc).
I would like to know if the cell I am right clicking on is the one at the top of the list; is it named "cell_(number)"? If it is not, it checks the cell on top of that one. Does it have a name that starts with "cell_"? If not, check the one on top, etc. Until I can figure out the user clicked on an element of WHICH list.
TL;DR The actual question
I can use ActiveCell.Address, which gives me something like "A1" whether or not I have assigned a name to that cell. ActiveCell.Name gives "Sheet1!A1", so it's not much better. Any idea how to get it to return the name I have assigned instead?
Create a UDF to test the application names, it's less efficient but contains error handling within the function itself:
Sub SO()
'// Example how to call function
Debug.Print GetCellName(Range("A1"))
End Sub
Function GetCellName(myCell As Excel.Range) As Variant
Dim nameCheck As Variant
For Each nameCheck In Application.Names
If Replace(Replace(Replace(nameCheck, "=", ""), "'", ""), "!", "") = _
CStr(myCell.Parent.Name & myCell.Address) Then
GetCellName = CStr(nameCheck.Name)
Exit Function
End If
Next
GetCellName = CVErr(Excel.xlErrName)
End Function
Note you can also use this function in a worksheet cell like so:
=GetCellName(A1)
Perhaps this would work. This function returns the names assigned to a cell (or bigger range for that matter). If there's more than one name, it returns it as an array for array formula...or the user can supply an index to return only the desired name position
Public Function CellIsInRangeNames(sheetname As String, checkRange As Range, Optional itemNumber As Variant) As Variant
Dim oNM As Name
Dim oSht As Worksheet
Dim isect As Range
Dim namesCollection() As Variant
Set oSht = Worksheets(sheetname)
Dim i As Integer
i = -1
For Each oNM In oSht.Names
Set isect = Application.Intersect(Range(oNM.Name), checkRange)
If Not isect Is Nothing Then
i = i + 1
ReDim Preserve namesCollection(0 To i)
namesCollection(i) = CStr(oNM.Name)
End If
Next oNM
If i = -1 Then
'didn't find any
CellIsInRangeNames = xlErrName
ElseIf Not IsMissing(itemNumber) Then
'user wanted this instance only
If (itemNumber - 1 > UBound(namesCollection)) Or (itemNumber - 1 < LBound(namesCollection)) Then
CellIsInRangeNames = xlErrValue
Else
CellIsInRangeNames = namesCollection(itemNumber - 1)
End If
Else 'here's the list as an array
CellIsInRangeNames = namesCollection
End If
End Function

VBA Runtime Error 9: Subscript out of range

I have been trying to write a small piece of code to validate to confirm whether or not a date is included in an array. I have been able to scroll through the code until I reach the line If lists(i) = TodaysDate Then when the lists(i) show subscript out of range. I have searched through the Internet and I'm unable to resolve this issue.
My Macro reads as follows:
Sub size_an_array()
Dim i As Integer
Dim Range_of_Dates As Integer
Dim TodaysDate As Variant, finish As String
TodaysDate = Range("Sheet11!c2")
ThisWorkbook.Worksheets("Sheet11").Activate
lists = Range("Processed_Dates")
Range_of_Dates = UBound(lists, 1) - LBound(lists, 1) + 1
For c = 1 To UBound(lists, 1) ' First array dimension is rows.
For R = 1 To UBound(lists, 2) ' Second array dimension is columns.
Debug.Print lists(c, R)
Next R
Next c
x = Range_of_Dates 'UBound(lists, 1)
ReDim lists(x, 1)
i = 1
Do Until i = x
If lists(i) = TodaysDate Then
Exit Do
End If
Loop
MsgBox "The date has not been found"
End Sub
I'm relatively new to VBA and I have been trying to use named ranges to pull in the array but I'm completely at my wits end in trying to solve this piece.
Any help would be greatly appreciated.
You have ReDimmed the array lists from a one dimensioned array to a two dimensioned array and you are then trying to reference an element using only one dimension in the suspect line (below), which is causing your error.
If lists(i) = TodaysDate Then
For reference, Run-time error 9: Subscript out of range means you are referencing a non-existent array element.
I think this is what you are trying?
Sub size_an_array()
Dim i As Integer
Dim TodaysDate As Variant, lists
Dim bFound As Boolean
'~~> Change SomeWorksheet to the relevant sheet
TodaysDate = Sheets("SomeWorksheet").Range("c2")
lists = Sheets("Sheet11").Range("Processed_Dates")
i = 1
Do Until i = UBound(lists)
If lists(i, 1) = TodaysDate Then
bFound = True
Exit Do
End If
i = i + 1
Loop
If bFound = True Then
MsgBox "The date has been found"
Else
MsgBox "The date has not been found"
End If
End Sub
If I understand you correctly then it is much easier to use .Find. If you are interested then have a look at this link.

Excel VBA Type Mismatch (13)

I am getting a type mismatch error in VBA and I am not sure why.
The purpose of this macro is to go through a column in an Excel spreadsheet and add all the emails to an array. After each email is added to the first array, it's also supposed to added to a second array but split into two pieces at the # symbol in order to separate name from domain. Like so: person#gmail.com to person and gmail.com.
The problem that I'm getting is that when it gets to the point where it's supposed to split the email, it throws a Type Mismatch error.
Specifically this part:
strDomain = Split(strText, "#")
Here is the complete code:
Sub addContactListEmails()
Dim strEmailList() As String 'Array of emails
Dim blDimensioned As Boolean 'Is the array dimensioned?
Dim strText As String 'To temporarily hold names
Dim lngPosition As Long 'Counting
Dim strDomainList() As String
Dim strDomain As String
Dim dlDimensioned As Boolean
Dim strEmailDomain As String
Dim i As Integer
Dim countRows As Long
'countRows = Columns("E:E").SpecialCells(xlVisible).Rows.Count
countRows = Range("E:E").CurrentRegion.Rows.Count
MsgBox "The number of rows is " & countRows
'The array has not yet been dimensioned:
blDimensioned = False
Dim counter As Long
Do While counter < countRows
counter = counter + 1
' Set the string to the content of the cell
strText = Cells(counter, 5).Value
If strText <> "" Then
'Has the array been dimensioned?
If blDimensioned = True Then
'Yes, so extend the array one element large than its current upper bound.
'Without the "Preserve" keyword below, the previous elements in our array would be erased with the resizing
ReDim Preserve strEmailList(0 To UBound(strEmailList) + 1) As String
Else
'No, so dimension it and flag it as dimensioned.
ReDim strEmailList(0 To 0) As String
blDimensioned = True
End If
'Add the email to the last element in the array.
strEmailList(UBound(strEmailList)) = strText
'Also add the email to the separation array
strDomain = Split(strText, "#")
If strDomain <> "" Then
If dlDimensioned = True Then
ReDim Preserve strDomainList(0 To UBound(strDomainList) + 1) As String
Else
ReDim strDomainList(0 To 0) As String
dlDimensioned = True
End If
strDomainList(UBound(strDomainList)) = strDomain
End If
End If
Loop
'Display email addresses, TESTING ONLY!
For lngPosition = LBound(strEmailList) To UBound(strEmailList)
MsgBox strEmailList(lngPosition)
Next lngPosition
For i = LBound(strDomainList) To UBound(strDomainList)
MsgBox strDomainList(strDomain)
Next
'Erase array
'Erase strEmailList
End Sub
ReDiming arrays is a big hassle. Welcome to the world of collections and Dictionarys. Collection objects are always accessible. Dictionaries require a reference to Microsoft Scripting Runtime (Tools>References>scroll down to find that text and check the box> OK). They dynamically change size for you, you can add, remove items very easily compared to arrays, and Dictionaries especially allow you to organize your data in more logical ways.
In the below code I used a dictionary there the key is the domain (obtained with the split function). Each value for a key is a collection of email addresses with that domain.
Put a break point on End Sub and look at the contents of each of these objects in your locals window. I think you'll see they make more sense and are easier in general.
Option Explicit
Function AllEmails() As Dictionary
Dim emailListCollection As Collection
Set emailListCollection = New Collection 'you're going to like collections way better than arrays
Dim DomainEmailDictionary As Dictionary
Set DomainEmailDictionary = New Dictionary 'key value pairing. key is the domain. value is a collection of emails in that domain
Dim emailParts() As String
Dim countRows As Long
Dim EmailAddress As String
Dim strDomain As String
'countRows = Columns("E:E").SpecialCells(xlVisible).Rows.Count
Dim sht As Worksheet 'always declare your sheets!
Set sht = Sheets("Sheet1")
countRows = sht.Range("E2").End(xlDown).Row
Dim counter As Long
Do While counter < countRows
counter = counter + 1
EmailAddress = Trim(sht.Cells(counter, 5))
If EmailAddress <> "" Then
emailParts = Split(EmailAddress, "#")
If UBound(emailParts) > 0 Then
strDomain = emailParts(1)
End If
If Not DomainEmailDictionary.Exists(strDomain) Then
'if you have not already encountered this domain
DomainEmailDictionary.Add strDomain, New Collection
End If
'Add the email to the dictionary of emails organized by domain
DomainEmailDictionary(strDomain).Add EmailAddress
'Add the email to the collection of only addresses
emailListCollection.Add EmailAddress
End If
Loop
Set AllEmails = DomainEmailDictionary
End Function
and use it with
Sub RemoveUnwantedEmails()
Dim allemailsDic As Dictionary, doNotCallSheet As Worksheet, emailsSheet As Worksheet
Set doNotCallSheet = Sheets("DoNotCallList")
Set emailsSheet = Sheets("Sheet1")
Set allemailsDic = AllEmails
Dim domain As Variant, EmailAddress As Variant
Dim foundDoNotCallDomains As Range, emailAddressesToRemove As Range
For Each domain In allemailsDic.Keys
Set foundDoNotCallDomains = doNotCallSheet.Range("A:A").Find(domain)
If Not foundDoNotCallDomains Is Nothing Then
Debug.Print "domain found"
'do your removal
For Each EmailAddress In allemailsDic(domain)
Set emailAddressesToRemove = emailsSheet.Range("E:E").Find(EmailAddress)
If Not emailAddressesToRemove Is Nothing Then
emailAddressesToRemove = ""
End If
Next EmailAddress
End If
Next domain
End Sub
strDomain must store array of the split text, therefore,
Dim strDomain As Variant
Afterwards, strDomain should be referenced by index, if operations with certain fragments will be made:
If strDomain(i) <> "" Then
The split function returns an array of strings based on the provided separator.
In your if you are sure that the original string is an email, with just one "#" in it then you can safely use the below code:
strDomain = Split(strText, "#")(1)
This will get you the part after "#" which is what you are looking for.
Split returns an array:
Dim mailComp() As String
[...]
mailComp = Split(strText, "#")
strDomain = mailComp(1)
Try strDomain = Split(strText,"#")(1) to get the right hand side of the split where (0) would be the left. And of course works with more than 2 splits as well. You could dim you string variable as an array strDomain() and then Split(strText,"#") will place all the seperated text into the array.