I have a list in excel adn I want to make it an array to delete column names that match. The following works:
arrColumnNames = Array("Month", "Day")
However I want a dynamic list. I have also tried
arrColumnNames = Worksheets("List").Range("J2:J35").Value
But that crashes excel.
Thanks a lot.
I think something like this should work well enough, without frills.
Sub RemoveColumnsWithDiffHeaders()
Dim MainSht As Worksheet, RefSht As Worksheet
Dim HeaderList As Range, Cell As Range
With ThisWorkbook
Set MainSht = .Sheets("Sheet1") 'Modify as needed.
Set RefSht = .Sheets("Sheet2") 'Modify as needed.
End With
Set HeaderList = RefSht.Range("A1:A8") 'Modify as needed.
For Each Cell In MainSht.Rows(1).Cells
If Application.CountIf(HeaderList, Cell.Value) = 0 Then
MainSht.Columns(Cell.Column).EntireColumn.Delete
End If
Next Cell
End Sub
HeaderList contains the list of headers to retain. Modify all other ranges/assignments to suit.
Let us know if this helps.
dim arrColumnNames() as variant
redim arrColumnNames (2 to 35, 1 to 1) 'not really needed, but i use it like this to paste data again back to sheet after doing operations, much faster than doint it by reading each cell.
arrColumnNames = Worksheets("List").Range("J2:J35").Value
'code , calculation on arrColumnNames ...
Worksheets("List").Range("J2:J35").Value = arrColumnNames 'writes back to sheet, 'instantenuously'.
redim arrColumnNames (0,0)
erase arrColumnNames 'i am not sure if need redim but if i understood, the erase function only puts blanks in the data, so the array still take a bit of memory. Whatever, i'm a noob.
this code only is usefull(performance) if you work with many cells/rows/big range(...) (over 100 or 1000), or if you want to make arrays ;)
Related
I have 2 workbooks open, and I am trying to copy one range of cells from one workbook into the other workbook based on a condition. The program keeps on breaking at the first For Each loop with the
Subscript out of range
error and I am lost as to why.
I looked at other threads here, and they said that the error comes from not having an Open workbook. I implemented that, and it still gives me this error.
I am new to VBA. Any ideas?
Sub TransferCells()
Dim aggrange As Range
Dim AnalyticalCell As Range
Dim BatchCell As Range
Dim analyticalwb, batchwb As Excel.Workbook
Dim SEHPLC, CultureDay As Worksheet
Set analyticalwb = Workbooks.Open("\\ntucsmafps06.na.jn.com\Hom$\APachall\Ta Big Data\Cas tical Results (4).xlsm")
Set batchwb = Workbooks.Open("\\nctusmafp0s6.na.jn.com\Hom$\APachall\Ta Big Data\20180420_Fed Batch All Data_0.xlsx")
For Each AnalyticalCell In analyticalwb.Worksheets("SE-HPLC").Range("A1:A87")
For Each BatchCell In batchwb.Worksheets("Sheet3").Range("A2:A125271")
If AnalyticalCell.Value = BatchCell.Value Then
Set aggrange = Range(ActiveCell.Offset(0, 11), ActiveCell.Offset(0, 13))
aggrange.Copy (Destination = Application.Workbooks("20180420_Fed Batch All Data_0.xlsx").Worksheets("Sheet3").Range(ActiveCell.Offset(0, 3), ActiveCell.Offset(0, 5)))
End If
Next BatchCell
Next AnalyticalCell
End Sub
Change the problematic code to the following. There are 2 errors there:
With Worksheets(ActiveCell.Parent.Name)
aggrange.Copy Destination:=Application.Workbooks("20180420_Fed Batch All Data_0.xlsx").Worksheets("Sheet3").Range(.Cells(ActiveCell.Offset(0, 3)), .Cells(ActiveCell.Offset(0, 5)))
End With
Destination is a named parameter, thus it should be passed with := and not with =;
To pass a range, based on two cells, you need to pass:
Range(.Cells(ActiveCell.Offset(0, 3)), .Cells(ActiveCell.Offset(0, 5))) and not Range(). Range() takes string as arguments.
Further ideas - the Dim should be done per variable. In other languages (C++, etc) it is ok, in vba it is a bit problematic:
Dim analyticalwb As Excel.Workbook, batchwb As Excel.Workbook
Dim SEHPLC As Worksheet, CultureDay As Worksheet
How to avoid using Select in Excel VBA
Write Option Explicit on the top of the Module and see whether it compiles.
I've started to use Macros this weekend (I tend to pick up quickly in regards to computers). So far I've been able to get by with searching for answers when I have questions, but my understanding is so limited I'm to a point where I'm no longer understanding the answers. I am writing a function using VBA for Excel. I'd like the function to result in a range, that can then be used as a variable for another function later. This is the code that I have:
Function StartingCell() As Range
Dim cNum As Integer
Dim R As Integer
Dim C As Variant
C = InputBox("Starting Column:")
R = InputBox("Starting Row:")
cNum = Range(C & 1).Column
Cells(R, cNum).Select
The code up to here works. It selects the cell and all is well in the world.
Set StartingCell = Range(Cell.Address)
End Function
I suppose I have no idea how to save this location as the StartingCell(). I used the same code as I had seen in another very similar situation with the "= Range(Cell.Address)." But that's not working here. Any ideas? Do I need to give more information for help? Thanks for your input!
Edit: I forgot to add that I'm using the InputBox to select the starting cell because I will be reusing this code with multiple data sets and will need to put each data set in a different location, each time this will follow the same population pattern.
Thank you A.S.H & Shai Rado
I've updated the code to:
Function selectQuadrant() As Range
Dim myRange As Range
Set myRange = Application.InputBox(Prompt:="Enter a range: ", Type:=8)
Set selectQuadrant = myRange
End Function
This is working well. (It appears that text is supposed to show "Enter a range:" but it only showed "Input" for the InputBox. Possibly this could be because I'm on a Mac?
Anyhow. I was able to call the function and set it to a new variable in my other code. But I'm doing something similar to set a long (for a color) so I can select cells of a certain color within a range but I'm getting all kinds of Object errors here as well. I really don't understand it. (And I think I'm dealing with more issues because, being on a mac, I don't have the typical window to edit my macros. Just me, basically a text box and the internet.
So. Here also is the Function for the Color and the Sub that is using the functions. (I've edited both so much I'm not sure where I started or where the error is.)
I'm using the functions and setting the variables to equal the function results.
Sub SelectQuadrantAndPlanets()
Dim quadrant As Range
Dim planetColor As Long
Set quadrant = selectQuadrant()
Set planetColor = selectPlanetColor() '<This is the row that highlights as an error
Call selectAllPlanets(quadrant, planetColor)
End Sub
This is the function I'm using to select the color that I want to highlight within my range
I would alternately be ok with using the interior color from a range that I select, but I didn't know how to set the interior color as the variable so instead I went with the 1, 2 or 3 in the input box.
Function selectPlanetColor() As Long
Dim Color As Integer
Color = InputBox("What Color" _
& vbNewLine & "1 = Large Planets" _
& vbNewLine & "2 = Medium Planets" _
& vbNewLine & "3 = Small Planets")
Dim LargePlanet As Long
Dim MediumPLanet As Long
Dim smallPlanet As Long
LargePlanet = 5475797
MediumPlanet = 9620956
smallPlanet = 12893591
If Color = 1 Then
selectPlanetColor = LargePlanet
Else
If Color = 2 Then
selectPlanetColor = MediumPlanet
Else
If Color = 3 Then
selectPlanetColor = smallPlanet
End If
End If
End If
End Function
Any help would be amazing. I've been able to do the pieces individually but now drawing them all together into one sub that calls on them is not working out well for me. Thank you VBA community :)
It's much simpler. Just
Set StartingCell = Cells(R, C)
after getting the inputs, then End Function.
The magic of the Cells method is it accepts, for its second parameter, both a number or a character. That is:
Cells(3, 4) <=> Cells(3, "D")
and
Cells(1, 28) <=> Cells(3, "AB")
One more thing, you can prompt the user directly to enter a range, with just one input box, like this:
Dim myRange as Range
Set myRange = Application.InputBox(Prompt:="Enter a range: ", Type:=8)
The Type:=8 specifies the input prompted for is a Range.
Last thing, since you are in the learning process of VBA, avoid as much as possible:
using the Select and Activate stuff
using unqualified ranges. This refers to anywhere the methods Cells(..) or Range(..) appear without a dot . before them. That usually leads to some random issues, because they refer to the ActiveSheet, which means the behavior of the routine will depend on what is the active worksheet at the moment they run. Avoid this and always refer explicitly from which sheet you define the range.
Continuing your line of thought of selecting the Range bu Selecting the Column and Row using the InputBox, use the Application.InputBox and add the Type at the end to restrict the options of the user to the type you want (Type:= 1 >> String, Type:= 2 >> Number).
Function StartingCell Code
Function StartingCell() As Range
Dim cNum As Integer
Dim R As Integer
Dim C As Variant
C = Application.InputBox(prompt:="Starting Column:", Type:=2) '<-- type 2 inidcates a String
R = Application.InputBox(prompt:="Starting Row:", Type:=1) '<-- type 1 inidcates a Number
Set StartingCell = Range(Cells(R, C), Cells(R, C))
End Function
Sub TestFunc Code (to test the function)
Sub TestFunc()
Dim StartCell As Range
Dim StartCellAddress As String
Set StartCell = StartingCell '<-- set the Range address to a variable (using the function)
StartCellAddress = StartCell.Address '<-- read the Range address to a String
End Sub
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
I'm having trouble with my Listbox. When I run the following code for the first time, it always runs showing only 1 date which is 30/12/1899. The range that I've specified only contains 6 dates which are 8/1/2014, 9/1/2014, 14/1/2014, 24/1/2014, 24/1/2014 and 02/02/2014.
Once I stop the form and run it again, all the required dates show up.
I've just started learning VBA on Excel so I'm still struggling to understand the concepts.
Is there something that I'm missing? The reason for no duplicates is that I can't show the 2 dates (24/01/2014).
Private Sub UserForm_Activate()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item
Dim wksJobDetail As Worksheet
'The items are in A2:A7
Set AllCells = Range("A2:A7")
'Point the variable to JobSchedule worksheet
Set wksJobDetail = Application.Workbooks("xxxxx.xlsm").Worksheets("JobSchedule")
wksJobDetail.Activate
'Statement ignores any errors regarding duplicates and duplicate dates aren't added
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Format(CDate(Cell.Value), "dd/mm/yyyy"), _
CStr(Format(CDate(Cell.Value), "dd/mm/yyyy"))
Next Cell
'Add non-duplicated items into lstDate
For Each Item In NoDupes
JobDetail.lstDate.AddItem Item
Next Item
End Sub
Set AllCells = Range("A2:A7") will reference the active worksheet which may or may not be wksJobDetail.
The second time you run it wksJobDetail has been activated.
Try putting the Set AllCells = Range("A2:A7") statement after:
Set wksJobDetail = Application.Workbooks("xxxxx.xlsm").Worksheets("JobSchedule")
wksJobDetail.Activate
I think it has something to do with how you format your data in Excel and the proper way of referencing source range.
Try this:
First, check if the dates are correctly entered as dates in Excel like below.
Then make this line explicit:
Set AllCells = Range("A2:A7")
and change to this:
Set AllCells = Sheets("JobSchedule").Range("A2:A7")
Now, run your code which I've rewritten below adding On Error Goto 0.
Dim AllCells As Range, Cell As Range, Item
Dim NoDupes As New Collection
Set AllCells = Sheets("JobSchedule").Range("A2:A7")
On Error Resume Next '~~> Ignore Error starting here
For Each Cell In AllCells
NoDupes.Add Format(CDate(Cell.Value), "dd/mm/yyyy"), _
CStr(Format(CDate(Cell.Value), "dd/mm/yyyy"))
Next Cell
On Error GoTo 0 '~~> Stops ignoring error
For Each Item In NoDupes
JobDetail.lstDate.AddItem Item
Next Item
And that should give you the result you want. Also, I suggest to use Initialize Event instead of Activate.
Everytime you use OERN, do not forget to use OEG0 to reset the error handling.
Otherwise, you will not be able to trap other errors not related to the adding existing item in Collection.
Bonus:
Another way to do this is to use a Dictionary instead. You need to add reference to Microsoft Scripting Runtime. I rewrote part of your code which will have the same effect. The advantage of a Dictionary is that it offers other helpful properties that you can use.
Private Sub UserForm_Initialize()
Dim AllCells As Range, Cell As Range
Dim d As Dictionary
Set AllCells = Sheets("Sheet1").Range("A2:A7")
Set d = New Dictionary
For Each Cell In AllCells
d.Item(Format(CDate(Cell.Value), "dd/mm/yyyy")) = _
CStr(Format(CDate(Cell.Value), "dd/mm/yyyy"))
Next Cell
JobDetail.lstDate.List = d.Keys
End Sub
As you can see, we removed one Loop by using Keys property which is an array of all unique keys. I hope this somehow helps.
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").