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
Related
I wrote the following function to check if the prerequisites for my Excel row are satisified.
Public Function PREREQUISITESOK(prerequisites As Range) As String
Dim cw As Worksheet
Dim prerequisite_cell As Range
Dim prerequisite_cell_txt As String
Dim training_id_cell As Range
Dim no_groups_cell_to_compare As Range
Dim no_groups_cell_to_check As Range
Dim training_id_cell_txt As String
Dim training_id_cell_row_n As Integer
Dim n As Integer
Application.Volatile
PREREQUISITESOK = "OK"
Set cw = Sheets("4c.Trainings OSS")
Set training_id = cw.Range("$B$11:$B$34")
Set no_groups_cell_to_compare = cw.Range("J" & CStr(prerequisites.Row))
For Each prerequisite_cell In prerequisites.Cells
prerequisite_cell_txt = prerequisite_cell.Text
If prerequisite_cell_txt = "" Then
Exit For
Else
For Each training_id_cell In training_id.Cells
training_id_cell_txt = training_id_cell.Text
If training_id_cell_txt = prerequisite_cell_txt Then
training_id_cell_row_n = training_id_cell.Row
Set no_groups_cell_to_check = cw.Cells(training_id_cell_row_n, no_groups_cell_to_compare.Column)
If no_groups_cell_to_check.Value < no_groups_cell_to_compare.Value Then
PREREQUISITESOK = "NOT OK"
Exit Function 'It is enough for us that one prerequisite is not satisfied so we can exit the function
Else
PREREQUISITESOK = "OK"
End If
Exit For 'Training IDs are unique so if we find the right Training ID then we may exit the loop
End If
Next training_id_cell
End If
Next prerequisite_cell
End Function
Note that the prerequisites range is inline formatted.
The function that I wrote is supposed to return String value so I completely do not understand why am I getting #VALUE! error.
What is interesting that if I clear formatting from the prerequisites cells that are used as arguments of the function then #VALUE! error disappears.
Do you have any idea why this happens?
Private Sub FillRow(programCell As Range, storedProgramCell As Range)
Dim counter As Integer
For counter = 3 To 9
Dim cellOffset As Integer
cellOffset = counter - 3
Dim currentStoredCell As Range
Set currentStoredCell = storedProgramCell.Offset(0, cellOffset)
Dim value As String
value = currentStoredCell.value
Dim currentTargetCell As Range
Set currentTargetCell = programCell.Offset(0, cellOffset)
MsgBox currentStoredCell.value 'Works correctly, prints correct value
currentTargetCell.value = value
Next counter
End Sub
The line:
currentTargetCell.value = value
causes the code to stop executing, with no error.
I added the expression to my watch list, then stepped through the routine. The expression was seen as a Boolean:
This makes me think the expression is being viewed as a comparison, and the program abruptly ends since the returned Boolean is not being stored or used anywhere. I wouldn't doubt if I were wrong though.
I'm new to VBA, struggling to debug my program, so please forgive me if this is a petty mistake. I couldn't find any sources online that explains this problem.
Replace your subroutine with following code:
Private Sub FillRow(Dst As Range, Src As Range)
Dim x As Integer
Dim v As Variant
Dim Srcx As Range
Dim Dstx As Range
Debug.Print "FillRow"
Debug.Print Src.Address
Debug.Print Dst.Address
Debug.Print "Loop"
For x = 0 To 6
Debug.Print x
Set Srcx = Src.Offset(0, x)
Debug.Print Srcx.Address
v = Srcx.Value
Debug.Print TypeName(v)
Set Dstx = Dst.Offset(0, x)
Debug.Print Dstx.Address
Dstx.Value = v
Next
Debug.Print "Completed"
End Sub
Run and post in your question Immediate window output.
Value is a reserved word, even if vba does not raise an error on this name, you should not use it. Name it something else. Also, try setting it as a variant.
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
I am trying to determine if a table exists, using VBA Excel 2007, and if it exists then delete it.
I am looping through an array of table names.
My code is below:
' Allocate
Dim lIndex As Long
' Allocate table header values in array
Dim sTableNames(1 To Constants.lNumTables) As String
' Populate array
sTableNames(1) = Constants.sTableNameKpiAllIncidents
sTableNames(2) = Constants.sTableNameSlaAllManualHelpdeskIncidents
sTableNames(3) = Constants.sTableNameSlaAllManualIncidents
sTableNames(4) = Constants.sTableNameKpiAllAutomaticIncidents
' Work in worksheet Statistics
With Worksheets(Constants.sSheetNameStatistics)
' Loop through all tables
For lIndex = 1 To UBound(sTableNames)
' Check if table already exists
If Not .ListObjects(sTableNames(lIndex)) Is Nothing Then
' Delete table
.ListObjects(sTableNames(lIndex)).Delete
End If
Next
End With
My code works as long as these tables exist in my worksheet. I have also tried replacing the line
If Not .ListObjects(sTableNames(lIndex)) Is Nothing Then
with the line
If .ListObjects(sTableNames(lIndex)).Count > 0 Then
but it still doesn't work.
Does anybody know a way to get this to work?
Any help would be appreciated.
Error handling as nhee suggests is the right approach.
As a UDF the suggestion above would be quicker with:
Function TableExists(ws As Worksheet, tblNam As String) As Boolean
Dim oTbl As ListObject
On Error Resume Next
Set oTbl = ws.ListObjects(tblNam)
TableExists = Not oTbl Is Nothing
End Function
The following UDF will return a boolean if a table exists
Function TableExists(ws As Worksheet, tblNam As String) As Boolean
Dim oTbl As ListObject
For Each oTbl In ws.ListObjects
If oTbl.Name = tblNam Then
TableExists = True
Exit Function
End If
Next oTbl
TableExists = False
End Function
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