I am working with an excel file which contains the below values with some cell comments.
The below VB code is for copy the values and comments to an array.
Sub commentToArray()
arrayValues = Range("A1:A6").Value
arrayComments = Range("A1:A6").Comment.Text
End Sub
The values array is working fine, but the comments array populating an error message.
Could you please help me to sort this out.
Thanks,
Aneesh
Your code have two errors:
You can't use Comment.Text method for a range of multiple cells.
You cant' use the Comment.Text on a cell that doesn't contains a comment.
This can be a solution for you:
Sub commentToArray()
Dim arrayValues As Variant
Dim ArrayCommnents() As String
Dim myRange, commentsRange, mycell As Range
Dim i As Integer
arrayValues = Range("A1:A6").Value
Set myRange = ActiveSheet.Range("A1:A6")
Set commentsRange = myRange.Cells.SpecialCells(xlCellTypeComments)
arrayLenght = commentsRange.Count
ReDim arrayComments(arrayLenght)
For Each mycell In commentsRange
i = i + 1
arrayComments(i) = mycell.Comment.Text
Debug.Print (arrayComments(i))
Next mycell
End Sub
Explanation:
I use myRange var with the range to evaluate for comments.
Next, I need to determine wich cells contain a comment, this is the purpose of commentsRange var.
I've used the .SpcialCells() method to get only cells with comments.
Then, I get the lenght of the commentsRange with .Count property. I get the number of cells that constain a comment.
Redimension the array of comments is needed.
The For Each loop is to get cell by cell comments in the range of cells with comments. An incremental index i to run the array and you got it.
Related
I need a VBA code that clears only cells containing formulas and skip cells containing values in a given Excel Worksheet.
I have the following Code:
Dim rng As Range, cl As Range
Set rng = ThisWorkbook.Sheets("MATRIX").Range("C2:AU10000")
For Each cl In rng
If cl.Hyperlinks = .Hyperlinks Then
cl.ClearContents
End If
Next cl
Try this approach, please:
If cl.HasFormula Then
cl.ClearContents
End If
This should be the quickest way
rng.SpecialCells(xlCellTypeFormulas).ClearContents
HasFormula vs SpecialCells(xlTypeCellTypeFormulas)
Option Explicit
Sub RemoveHasFormula()
Dim rng As Range, cl As Range
Set rng = ThisWorkbook.Sheets("MATRIX").Range("C2:AU10000")
For Each cl In rng
If cl.HasFormula Then cl.ClearContents
Next cl
End Sub
Sub RemoveSpecialCells()
Dim rng As Range
Set rng = ThisWorkbook.Sheets("MATRIX").Range("C2:AU10000")
rng.SpecialCells(xlCellTypeFormulas).ClearContents
End Sub
Delete formulae via a range's XML structure
For the sake of the art and in order to complete the above solutions I demonstrate a rather unknown approach using a range's xml spreadsheet value (so called ".Value(11)"):
Option Explicit
Sub ExampleCall()
Dim rng As Range: Set rng = Sheet1.Range("a11:b14")
'a) Get range data as xml spreadsheet value
Dim s As String: s = rng.value(xlRangeValueXMLSpreadsheet) ' //or: s = rng.Value(11)
'b) delete formulae and write data back to range
ClearFormulae s ' call sub changing s (By Reference)
rng.value(xlRangeValueXMLSpreadsheet) = s
End Sub
Sub ClearFormulae(s)
'Purpose: delete formulae in xlRangeValueXMLSpreadsheet contents of a given range
'Author : https://stackoverflow.com/users/6460297/t-m
'Date : 2020-07-18
'[1]Set xml document to memory
Dim xDoc As Object: Set xDoc = CreateObject("MSXML2.DOMDocument.6.0")
'[2]Add namespaces.
xDoc.SetProperty "SelectionNamespaces", _
"xmlns:ss='urn:schemas-microsoft-com:office:spreadsheet' " & _
"xmlns:ht='http://www.w3.org/TR/REC-html40'"
'[3]Load cells with formulae into xml document.
If xDoc.LoadXML(s) Then ' load wellformed string content
Dim cell As Object, cells As Object
Set cells = xDoc.SelectNodes("//ss:Cell[#ss:Formula]") ' XPath using namespace prefixes
For Each cell In cells
cell.RemoveAttribute ("ss:Formula")
cell.SelectSingleNode("ss:Data/#ss:Type").Text = "String"
cell.SelectSingleNode("ss:Data").Text = ""
Next cell
'[4] return xml as string content
s = xDoc.XML
End If
End Sub
Further hint to Example call
Instead of replacing the same range, you can also copy the whole data set (including formats) to another sheet via:
Sheet2.Range("D2").Resize(rng.Rows.Count, rng.Columns.Count).value(11) = s
Caveat
As #ChrisNeilson pointed out,
"this can also gives unexpected results in some circumstances
where the range being processed by ClearFormulae includes some cells
that contain formula referring to cells outside the range being processed".
Testing Value(11) against other solutions
Testing with a 20% formula rate (in a double column range) shows that the SpecialCells approach (posted by #Storax and #VBasic2008) starts extremely fast, but looses against my Value(11) approach as soon as the data range exceeds ~ 115,100 rows.
The HasFormula solution (#FaneDuru) seems to be restricted to smaller ranges getting soon time consuming at ranges over 10000 rows.
I'm concatenating using an excel range:
Set rng = Range("A1:A8")
If one of the cells withing the range is empty it adds a single space.
How do you stop this space from being added?
Assuming you have got constants in those non-empty cells:
Set rng = Range("A1:A8").SpecialCells(2)
Unfortunately, non-contiguous ranges make that we can't put rng into an array or use it in a Join operation. You'll have to loop each cell in the range.
However, I would utilize Application.Trim instead of setting a range. This way we can work through memory (array) instead of a more sluggish Range object reference:
Sub Test()
Dim arr As Variant: arr = [TRANSPOSE(A1:A8)]
Debug.Print Application.Trim(Join(arr, " "))
End Sub
Or, if you don't want to utilize .Evaluate:
Sub Test()
Dim arr As Variant: arr = Range("A1:A8")
With Application
Debug.Print .Trim(Join(.Transpose(.Index(arr, 0, 1)), " "))
End With
End Sub
Note-1: We need Transpose to return a 1D-array to be able to use in Join.
Note-2: If one has got access to TEXTJOIN function, there is no need for all this, but you can utilize that function in an array form.
If you are concatenating range then a simple loop may help:
Dim rng As range, cell As range
For Each cell In range("A1:A8") ' looking through the desired range
If Not cell = "" Then ' if the cell is not empty we have to add it to range
If Not rng Is Nothing Then ' if the range already has some cells in it
Set rng = Union(rng, cell) ' we have to add the cell to an existing range
Else ' if the range does not yet exists
Set rng = cell ' create it and add the first cell
End If
End If
Next
This code was working just fine, but I did a bunch of other code that manipulates and reads the same area of the sheet and now this section does not work.
I have tried a bunch of stuff with syntax but none worked. It may be that I need to resize my array but since im setting it equal to a range I didnt think that I had to. Also It says the problem is the range but I dont know. I would rather not have to resize as its taking from a larger table whose line items will be dynamic but I can do that and make it dynamic if I need to. I did try deleting the range and renaming it and it did not work.
Private Sub UserForm_Initialize()
Dim codes()
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
codes = ws.Range("cCodes")
CostCode1.List = codes ''these are combo boxes
CostCode2.List = codes
CostCode3.List = codes
CostCode4.List = codes
CostCode5.List = codes
CostCode6.List = codes
'' ADD UNITS
End Sub
you don't need to declare the sheet for the named range.
named ranges are stored as an external address including the sheet's Name.
codes = Range("cCodes")
should be sufficient.
As far as I can tell the error comes because you don't have the named range "cCodes").
Go to Formulas -> Name Manager and check your names. Alternatively, use a range directly in the code, i.e.: codes = ws.Range("A1:A100")
To answer your question in the comment:
Is there a way for me to directly reference the three columns of the table that I want to set to the array
Here are a few ways to manipulate the range from your table into the array (specific rows/columns), and back on the sheet (see comments in code). Hope this helps.
Option Explicit
Sub test()
Dim rngData As Range
Dim arrData As Variant
With Range("Table1") 'this is only the content of the table, does not include the headers
Set rngData = Range(.Cells(1, 1), .Cells(.Rows.Count, 3)) 'Set the range starting at cell row 1, col 1 - until total number of rows in table, col 3
'Set rngData = rngData.Offset(-1).Resize(.Rows.Count + 1) 'if you want to include headers as well
Debug.Print rngData.Address
End With
arrData = rngData 'allocate the data from the range to the array
rngData.Offset(0, Range("Table1").Columns.Count + 1) = arrData 'put the array back on the sheet, 1 column to the right of the table
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
ws.Range("N1").Resize(UBound(arrData), UBound(arrData, 2)) = arrData 'put the array back on the sheet in a specific range
End Sub
I need to concatenate a dynamic range using VBA.
My best guess so far was to create a function and then calling the function via VBA to a specific cell. Here is the code i'm using:
Sub test()
I used this method to declare the variable just to shorten the code. Basically the last column that may contain data will always vary and is never the same. I already have the code working in order to determine the last column that contains data so let's just say in this case the last column is column G (or column 7)
Dim LASTCOLUMN As Integer: LASTCOLUMN = 7
What i need is to get the concatenated range in cell A1. My best guess is the following code but i also tried several other options and all of them failed. Can someone please help me with this line of code? It needs to be dynamic in order to incorporate the dynamic variable LASTCOLUMN.
Range("A1").Formula = "=ConcatRange(Cells(2, 1):Cells(LASTCOLUMN, 1)" End Sub
This is the function that concatenates a given range
Function ConcatRange(myrange As Range) As String
Dim CurrentRange As String
Dim r As String
CurrentRange = ""
For Each cell In myrange
If cell <> "" Then
r = cell
CurrentRange = CurrentRange & r
End If
Next cell
ConcatRange = CurrentRange
End Function
1) My objective is the following one:
To replace the content of a cell with a conditional statement that is either "Monitorato" or "Non Monitorato". The Condition determining the type of statement is the output of a Vlookup function. IF vlookup finds a value I would have "Monitorato", while if this does not happen I would have "Non Monitorato".
2) By using traditional excel functions, the thing is solved In this way:
=IF(ISNA(VLOOKUP(cell to look for, range, column, false)),"Non Monitorato","Monitorato")
I then copy and paste this formula to all the cells below the one I wrote the initial formula
3) However I would like to implement this thing using VBA.
Moreover, there is an additional problem. The data are actually filtered, so I need to use the Vlookup function only on the filtered data. The Vlookup function should look for the first visible cell in the dataset.
4) The horrible code that I wrote is the following one:
Sub MyFunction()
Dim i As Long
Dim LastRow As Long
Dim FirstRow As Long
Dim Header As Range
Set Header = Range("d1")
FirstRow = Range(Header.Offset(1, 0), Header.End(xlDown)).SpecialCells(xlCellTypeVisible).Cells(1).Count
LastRow = ActiveSheet.UsedRange.Rows.SpecialCells(xlCellTypeVisible).Count
For i = FirstRow To LastRow
Sheets(1).Cells(FirstRow, 5) = Application.WorksheetFunction.VLookup(Sheets(1).Cells(i, 3), Sheets(1).Range("C2:D100"), 2)
Next i
End Sub
The error I am getting is
Unable to get the vlookup property of the worksheet function class
I would like to solve it, but I also know there must be an easier solution to the problem...
Thank you all!
There's actually several issues with the current code and it will not accomplish what you are after. See if this code works for you:
Sub Monitorato()
Dim ws1 as Worksheet
Set ws1 = Sheets(1)
Dim rLookup As Range, rCell as Range
With ws1
Set rLookup = .Range(.Range("D1"),.Range("D1").End(xlDown)).SpecialCells(xlCellTypeVisible)
For each rCell in rLookup
If Not .Range("C2:D100").Find(rCell.Offset(,-1).Value2) Is Nothing Then
rCell.Offset(,1).Value = "Monitorato"
Else
rCell.Offset(,1).Value = "Non-Monitorato"
End If
Next
End With
End Sub`