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
Related
I have code that will go to a range and insert a formula all the way down. The below code will go to range N17:N160 and insert a relative formula.
Sub Macro9()
Range("n17:n160").FormulaR1C1 = "=IF(RC[-11]="""","""",IFERROR(VLOOKUP(RC[-11],R17C42:R160C53,7,FALSE),""""))"
End Sub
It works. However, I need to add a level where it looks at range B17:B160 and any cell in that range that has a "Y" in it will not update with the formula, whereas any one without a "Y", will update. Basically if and row has a Y in column B, don't put the formula in, for every other cell in the range, do put the formula in.
Thanks
First time posting, sorry if I didn't format everything correctly.
You'll need to build a range reference that meest your criteria for adding the Formula,
Something like
Sub Macro9()
Dim rng As Range, rngFiltered As Range
Dim dat As Variant
Dim idx As Long
Set rng = Range("n17:n160")
dat = rng.Offset(0, -12).Value2 ' Column B data
rng.ClearContents ' Clear existing data from range
For idx = 1 To UBound(dat)
If dat(idx, 1) <> "y" Then
If rngFiltered Is Nothing Then
Set rngFiltered = rng.Cells(idx, 1)
Else
Set rngFiltered = Application.Union(rngFiltered, rng.Cells(idx, 1))
End If
End If
Next
rngFiltered.FormulaR1C1 = "=IF(RC[-11]="""","""",IFERROR(VLOOKUP(RC[-11],R17C42:R160C53,7,FALSE),""""))"
End Sub
I'm trying to build a VBA application that checks for a certain value, then adds a row on top for each time this value is found.
Sub copy()
Dim rng As Range
Dim row As Range
Dim cell As Range
Set rng = Range("B2:B10")
For Each row In rng.Rows
For Each cell In row.Cells
If cell.value = "test" Then
MsgBox "found" + cell.Address
cell.EntireRow.Insert
End If
Next cell
Next row
End Sub
Every time I try to run this function, however, it keeps adding rows on top of each other continuously and not for each occurrence.
If you loop the cells from top to bottom, adding the row will push your original range down, causing the next loop to evaluate the previous cell.
To avoid this, loop backwards (i.e. bottom to top):
Sub copy_test()
Dim rng As Range
Set rng = Range("B2:B10")
Dim i As Long
For i = rng.Cells.Count To 1 Step -1
If rng.Cells(i).Value = "test" Then
Debug.Print "Found"
rng.Cells(i).EntireRow.Insert
End If
Next i
End Sub
Note: Set rng = Range("B2:B10") is telling VBA that you are referring to Cells B2:B10 of the ActiveSheet which might not be what you want.
Please fully qualify your range to avoid this. (e.g. ThisWorkBook.Worksheets("Sheet1").Range("B2:B10") or use the code name of the worksheet Sheet1.Range("B2:B10").)
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.
To start with I'm not really a wise man. So I was trying to add up two values and display them in a third (that's easy) but I also wanted it to repeat an infinite amount of times (namely that it does the same for every row, let's say I place the result in I5, I want also, on every I under it (I6, I7, I8, etc...)
Should it be:
Private Sub Worksheet_Change()
if IsNumeric(Range("B1").sort) And IsNumeric(Range("B2").sort) then
Dim value1 As Single
Dim value2 As Single
range(I5).sort = value+1 + value2
End Sub
Or as I think I'm horribly mistaken?
You're using the .Sort property of Range where you should be using .Value.
There's a couple of ways to achieve what you're looking to do. First option is to iterate through the range and add the relevant value to each cell like so:
Public Sub addCells()
Dim rng As Range, cell As Range
'Set the sheet name
With ThisWorkbook.Worksheets("Sheet_Name")
'Set the range below:
Set rng = .Range("I1:I10")
'Loop through range and add cells together
For Each cell In rng
cell.Value = cell.Offset(0, 2) + cell.Offset(0, 1)
Next cell
End Sub
Another way to do it if the values to be added is ordered in for example column A and B would be:
Public Sub addCells()
Dim rng As Range, cell As Range
'Set the sheet name
With ThisWorkbook.Worksheets("Sheet1")
'Add the first formula to the sheet
.Range("C1").Value = "=SUM(A1+B1)"
'Change the range below to the range to be filled
.Range("C1").AutoFill Destination:=.Range("C1:C10")
End With
End Sub
I'd like to create a macro that selects a rectangular range of cells and sets the name of every one of those cells to the value/contents of the cell.
In terms of what I've thought so far, I get an error though with the cell.Name line.
Public Sub NameCell()
Dim rng As Range
Dim cell As Range
Set rng = Range("A1:D1")
For Each cell In rng
cell.Name = CStr(cell.Value)
Next
End Sub
Is this what you meant?
Sub setVal()
Range("A1:C6").Select
Selection = "value"
End Sub
I believe this may work for you unless I also misunderstood the question.
Dim r As Range
Dim cell As Range
Set r = Sheet1.UsedRange
For Each cell In r
Sheet1.Names.Add Name:=cell.Value, RefersTo:=cell
Next
Keep in mind, though, that you would want to check that the cell.Value is valid (no spaces, etc.) for a named range.
To replace a range of cells with their values (removing any formulas from the range), you would use something like this.
Public Sub NameCell()
Dim rng As Range
Set rng = Range("A1:D1")
rng.Value = rng.Value
End Sub