I am writing a piece of code that transfers selected data on an Excel sheet into an array, which is then used to print the data on a new spreadsheet. However, I am getting a "Subscript Out of Range" error, even though a value appears when I scroll over selectArr(i - 1). Here is my code:
Sub Marascuilo()
Dim numRows As Integer 'Number of rows selected
numRows = Selection.Rows.Count
Dim selectArr() As Double 'Array containing numbers from selected cells
selectArr = loadArr(numRows) 'Load values into array
For i = 2 To UBound(selectArr) - LBound(selectArr) + 2
Sheets("Sheet 4").Cells(i, 2).Value = selectArr(i - 1)
Next
End Sub
'This function loads the values from the selected cells into selectArr.
Function loadArr(numRows) As Double()
Dim ResultArray() As Double
r = 1
For Each v In Selection
ReDim Preserve ResultArray(1 To r)
If v <> "" Then
ResultArray(r) = v.Value
r = r + 1
End If
Next
loadArr = ResultArray
End Function
Any ideas as to how I fix this issue?
Thanks!
Jay
Instead of using Sheets("Sheet 4"), you might consider using the sheet's CodeName. If you look in the Project Explorer window, every sheet has a Name and a CodeName. It might look like this
Sheet1 (Sheet1)
Sheet2 (Sheet2)
The first one is the CodeName (can't be changed from the UI). The one in parens is the tab name. Select the sheet in the Project Explorer and press F4 to open the Properties dialog. Go to the (Name) property (a poorly named property) and change it to something meaningful. I change all my sheets' CodeNames and use a wsh prefix. My sheet that's a log has a CodeName of
wshLog
Now I can use wshLog in my code and I get some benefits. The first is that if someone renames the sheet in the UI, the code still works. The second is I can type wshlog (all lower case) and the VBE will change it to wshLog and I get that visual cue that I spelled it right. Finally, my code is more readable, ex wshFinalReport vs. Sheets("Sheet1").
Related
I'm trying to dynamically assign a list to every combo box based on the values of a specific combo box. The idea is that the user picks a category from the specific combobox and all other combo boxes grab the items from that category in the form of a named list.
So the structure is like
Categories
Category 1
category 2
Category 1
Item 1
Item 2
And so on. I had this working on a fake set of names, but now that I'm using real named ranges, the code breaks. It is breaking on "For Each rng In ws.Range(str)" and stating that "method 'range' of object '_worksheet' failed.
This code works. Or worked. Then I changed ws to point to a different sheet of named ranges and now nothing works.
The value of CBOCategory is any value from a list of all named ranges, but it seems like Excel isn't seeing any of them! I tried to trigger even a listfill assignment instead of adding each item and got a similar error
Private Sub CBOCategory_Change()
'Populate dependent combo box with appropriate list items
'according to selection in cboCategoryList.
Dim rng As Range
Dim ws As Worksheet
Dim str, temp, cbName As String
Dim counter As Integer
Set ws = Worksheets("Item Master")
Dim obj As OLEObject
str = CBOCategory.Value
For Each obj In ActiveSheet.OLEObjects
If obj.Name = "CBOCategory" Then
' nothing
Else
temp = obj.Object.Value
obj.Object.Value = ""
For Each rng In ws.Range(str)
obj.Object.AddItem rng.Value
Next rng
obj.Object.Value = temp
End If
'MsgBox ("updated!")
Next obj
End Sub
The code works fine. The root cause of the issue is that the named ranges were being dynamically set by a formula. The formulas were not calculating properly when the code ran, so vba could not use a dynamically set named range to find another, also dynamically set named range.
The solution is to explicitly set the named ranges. Then the code works fine.
I am getting issues in using a dictionary in VBA. I want to add values from a sheet to a dictionary. If I use simple lists, there is no error in the code. Like this.
Function Account(Place As String) As String
Dim cities(500)
Dim accounts(500)
For i = 2 To 500
cities(i) = Worksheets("Sheet2").Cells(i, 2).Value
accounts(i) = Worksheets("Sheet2").Cells(i, 3).Value
Next i
placeName = StrConv(Place, vbProperCase)
Account = placeName
End Function
This code does not give an issue but if I add the code for the dictionary, there is some issue.
Function Account(Place As String) As String
Dim cities(500)
Dim accounts(500)
Dim dict
Set dict = CreateObject(Scripting.Dictionary)
For i = 2 To 500
cities(i) = Worksheets("Sheet2").Cells(i, 2).Value
accounts(i) = Worksheets("Sheet2").Cells(i, 3).Value
dict(cities(i)) = accounts(i)
Next i
placeName = StrConv(Place, vbProperCase)
Account = placeName
dict = Nothing
End Function
Can someone point out the error. I am new to vba so I dont know much about it.
The folowing UDF loads a dictionary object with places as keys (unique) and associated accounts as items. After the dictionary has been loaded, it looks up the Place parameter passed into the function and returns the account if found.
Option Explicit
Function Account(Place As String) As String
Static d As Long, dict As Object
If dict Is Nothing Then
Set dict = CreateObject("Scripting.Dictionary")
dict.comparemode = vbTextCompare
Else
dict.RemoveAll
End If
With Worksheets("Sheet2")
For d = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
dict.Item(.Cells(d, "B").Value2) = .Cells(d, "C").Value2
Next d
End With
If dict.exists(Place) Then
Account = dict.Item(Place)
Else
Account = "not found"
End If
End Function
Note that beyond other corrections, the code to instantiate the dictionary object is CreateObject("Scripting.Dictionary") not CreateObject(Scripting.Dictionary).
One possible area of concern, brought to mind by one of your comments, lies in the use of "Sheet1" and "Sheet2". In Excel VBA, there are two different ways to refer to a worksheet. The is the Name of the worksheet, which is what the user sees on the tabs in Excel, and the user can change at will. Thtese default to names like "Sheet1", "Sheet2", etc.
There is also the "Codename" for each worksheet. In the Visual Basic Editor, the project explorer window will list all the worksheets under "Microsoft Excel Objects". There you'll see the Codename for each worksheet, with the Name of the worksheet in parentheses.
When you use Worksheets("Sheet1"), the "Sheet1" refers to the Name, not the Codename. It's possible to end up with a worksheet with the Name "Sheet1" and the codename "Sheet2".
As far as your functions are concerned, I note that in both cases you declare local variables -- the arrays 'cities' and 'accounts' in the first, and those two plus the dictionary 'dict' in the second. You have code to fill those local variables, but then do nothing with them. The return value of the function is not dependent on any of those local variables.
Once the function code completes, those local variables lose their values. VBA returns the memory it used to store those variables to its pool of available memory, to be reused for other purposes.
Try commenting-out the entire for...next loop, and you'll see that the value return from the function is unchanged.
I'm not certain what you intend to accomplish in these functions. It would be helpful for you to explain that.
I know that this probably isn't the most ideal way to to do this but just bear with me.
I have a document with a few tables on it. I'm using a userform to search the tables/sub-categories and return the relevant values. I want to select the sub categories with a range of option buttons on a userform, these will in turn set the range for the search function to look within. I also want to dynamically update the option buttons if a new table was to be added or anything along those lines.
The only thing that differentiates the title of a sub-category/table, and the items within it, is that the title of a sub-category/table is bold. So what I'm looking to do is search the first column of the spreadsheet and return the names of any entries in bold. These values are then used to set the names of the option buttons :).
The following function is my attempt at finding the text entities in column a that are in bold, returning them and setting each to an individual variable to be used in another function. The bold1 .... variables are all globally defined variables as I need them in another sub, as is the page variable which contains the relevant page to be used. Currently the code returns an error stating "variable or with block not set" and using the debugger I can see that bold1 .... and all the other boldx variables have no value set. Does anybody know whats going on/how to fix this function.
Thanks in advance :)
Sub SelectBold()
Dim Bcell As Range
For Each Bcell In Worksheets(Page).Range("A1:A500")
If Bcell.Font.Bold = True Then
Set bold1 = Bcell
End If
Next
End Sub
EDIT: I simplified the above function, to remove clutter and help narrow in on the issue. I want the above function to store the contents of the found cell (any cell in the document in bold at this stage) in the variable bold1
This will return an array of values from bold cells in column A of Page.
You can fill a combo or list box with theses values using their list property.
ComboBox1.List = getSubCategories("Sheet1")
Function getSubCategories(Page As String) As String()
Dim arrSubCategories() As String
Dim count As Long
Dim c As Range
With Worksheets(Page)
For Each c In .Range("A2", .Range("A" & Rows.count).End(xlUp))
If c.Font.Bold Then
ReDim Preserve arrSubCategories(count)
arrSubCategories(count) = c.Value
count = count + 1
End If
Next
End With
getSubCategories = arrSubCategories
End Function
you may find useful to have a Range returned with subcategories cells found:
Function SelectBold(Page As String, colIndex As String) As Range
With Worksheets(Page)
With .Range(colIndex & "1", .Cells(.Rows.Count, colIndex).End(xlUp)).Offset(, .UsedRange.Columns.Count)
.FormulaR1C1 = "=if(isbold(RC[-1]),"""",1)"
.Value = .Value
If WorksheetFunction.CountA(.Cells) < .Rows.Count Then Set SelectBold = Intersect(.SpecialCells(xlCellTypeBlanks).EntireRow, .Parent.Columns(1))
.Clear
End With
End With
End Function
Function IsBold(rCell As Range)
IsBold = rCell.Font.Bold
End Function
to be possibly exploited as follows:
Option Explicit
Sub main()
Dim subCategoriesRng As Range, cell As Range
Set subCategoriesRng = SelectBold(Worksheets("bolds").Name, "A") '<--| pass worksheet name and column to search in
If Not subCategoriesRng Is Nothing Then
For Each cell In subCategoriesRng '<--| loop through subcategories cells
'... code
Next cell
End If
End Sub
Y helo thar,
actually my vba-knowledge is quite good and normally I don't have many difficulties coding , but this is driving me nuts.
Code is pretty easy. I have a worksheet PR_DB where all my projects are stored. For every project there are a number of employees, saved in cells (sel_pr, >10+) (employee name and ID).
I want to delete an employee from the project and tidy up the project database entry. All employees are listed in two listboxes. The ones that are working in the project, and the ones that don't. Via the buttons I can add and remove employees from either listbox.
When I add an employee to a project (top button), my Sub just puts the ID&Name at the end of the row of said project.
When I remove them from a project and therefore from the database, I look for the cell with the employee data. Afterwards I just want to cut all the cells to the right and paste them one cell to the left (via offset) so the deleted name is overwritten.
This is my code:
Sub delMA_from_prBetList()
Dim i, j, k, listRow, lastRowMA_DB, lastRowPR_DB, sel_pr As Integer
Dim wsPR, wsMA_DB, wsPR_DB As Worksheet
Dim foundMA As Boolean
Dim cutRng, pasteRng As Range
Set wsPR = Worksheets("Projekte")
Set wsMA_DB = Worksheets("MA_DB")
Set wsPR_DB = Worksheets("PR_DB")
lastRowPR_DB = wsPR_DB.UsedRange.Rows.Count
'check if any employee was selected
If IsNull(wsPR.prBetListe.Value) = True Then
MsgBox "Please select an employee."
Exit Sub
End If
j = 10
'look for selected project in DB
For i = 2 To lastRowPR_DB
If wsPR_DB.Cells(i, 1) = CInt(wsPR.prListe.Value) Then
'row ID of said project
sel_pr = i
End If
Next
'find employee
Do Until wsPR_DB.Cells(sel_pr, j) = ""
'employees are saved as "ID;NAME"
If wsPR_DB.Cells(sel_pr, j) = wsPR.prBetListe.Value & ";" & wsPR.prBetListe.Column(1, wsPR.prBetListe.ListIndex) Then
'when found, look for last cell with an entry
k = j
Do Until wsPR_DB.Cells(sel_pr, k) = ""
k = k + 1
Loop
'set cutRng so it spans from cell right to the found employee
'to last cell with an employee in that project
Set cutRng = wsPR_DB.Range(wsPR_DB.Cells(sel_pr, j + 1), wsPR_DB.Cells(sel_pr, k))
'set pasteRng like cutRng, just one cell further to the left
'so the deleted employee will be overwritten
Set pasteRng = cutRng.Offset(rowOffset:=0, columnOffset:=-1)
cutRng.Cut
pasteRng.PasteSpecial
Exit Do
End If
j = j + 1
Loop
're-initialize listboxes
Call init_maListe_dyn
Call init_prBetListe_dyn
End Sub
So whats the problem? Everything works just fine, all the cells I want to cut go into clipboard, but they arent pasted into the pasteRng. Error is
Error 1004 "Application-defined or Object-defined error". I tried a thousand things but the solution is probably too easy to find.
Hope you can help me, thanks in advance.
PS: I'm kind of in a hurry, so that text might not be as well formatted as it could be. Please bear with me.
just use directly:
cutRng.Cut pasteRng
this should solve your problem ;)
If you want to offset one column to the left it should be
Set pasteRng = cutRng.Offset(,-1)
Also, you're not defining how you want to paste. The paste settings may not be set to paste values if they were set differently prior to this instance (via code or otherwise). If you want to just cut-paste the values it would be
cutRng.Cut
pasteRng.PasteSpecial xlPasteValues
Let me know if that helps at all and if not I'll look further into it.
I am using VBA to help manage a set of data. I will have Monthly Data for 50 months and I wish to categorize it into different sheets based on the FIRST word within a cell. Here is what I done so far;
I created a workbook with 2 sheets,
Sheet1(Employee Inventory)
Sheet2(PB)
and my code is written and saved in this Workbook.
Sub myCode()
Dim OldString As String
Dim NewString As String
Set i = Sheets("Employee Inventory")
Set PB = Sheets("PB")
Dim counterPB
counterPB = 2
Dim d
Dim j
d = 1
j = 2
Do Until IsEmpty(i.Range("D" & j))
OldString = i.Range("D" & j)
NewString = Left(OldString, 2)
If NewString = "PB" Then
i.Rows(j).EntireRow.Copy
PB.Range("A" & counterPB).Select
PB.Paste
counterPB = counterPB + 1
End If
j = j + 1
Loop
End Sub
Apologies for the code as it looks weird. This code looks at Sheet1 and scans column "D" and looks for the first word starting with "PB". Once it does find it, it will copy and paste the whole row into another sheet called Sheet2(PB).
When I am in Microsoft Visual Basic window AND I have the Excel Spreadsheet with Sheet1(Employee Inventory) tab opened and when I click Run Sub I get the following error: Run-time error '1004': Application-defined or object-defined error. When I click on "PB" tab, nothing is being copy and pasted in there.
HOWEVER, when I click on the PB tab and then I click Run Sub, the codes executes and any rows containing the first word "PB" will be copied and pasted in the "PB" tab.
My question is, why does it only work when I have the Sheet2 opened and not when I have Sheet1 Opened?
when use range.select its parent worksheet must be selected, so we can use PB.Activate or not use .select at all.
Try to replace this:
i.Rows(j).EntireRow.Copy
PB.Range("A" & counterPB).Select
PB.Paste
with this line:
i.Rows(j).Copy PB.Rows(counterPB)
Why don't you just select the second sheet at the beginning of the code?
Try the following
ActiveWorkbook.Sheets("Sheet2").Activate
If it really works when this sheet is selected, then it should work with this.