I am trying to concatenate numbers in cells A1:A100 in to a single string. How do I do that referencing another sheet.Code is as follows
Sheets("Current").Cells(1,1).Formula = "=CONCATENATE('Reference Sheet'!A1:A100)"
But I am not getting anything. Please help
Its a one-liner:
MsgBox Join(Application.Transpose(Range("A1:A100")), vbNullString)
Dim oRng As Range
Dim cel As Range
Dim concStr as String
Set oRng = Range("A1:A100")
concStr = vbNullString
For Each cel in oRng
concStr = concStr & cel.value
Next cel
''Do stuff with concStr
The CONCATENATE function doesn't work on a range but on separate cells, i.e. CONCATENATE('Reference Sheet'!A1,'Reference Sheet'!A2,'Reference Sheet'!A3). If you always have 100 cells then you could use a loop:
Dim x As Integer
Dim formulaString As String
formulaString= "=CONCATENATE("
For x = 1 To 100
formulaString= formulaString & "'Reference Sheet'!A" & x & ","
Next x
' Remove last comma
formulaString= Left(formulaString, Len(formulaString) - 1)
' Add closing bracket
formulaString= formulaString& ")"
Sheets("Current").Cells(1,1).Formula = formulaString
Work with arrays, first create an array to hold the input value "A1:A100".
Then convert all numbers to strings within the array and join the array to obtain the resulting string and enter it in the required cell.
For this code using worksheets named "Source" and "Target" (modify as required)
Pls check comments in the code and see
https://msdn.microsoft.com/en-us/library/office/gg264098.aspx
Sub Rng_ConcatenateValues()
Dim aArySrc As Variant, vArySrc As Variant, sAryTrg As String
Dim l As Long
With ActiveWorkbook
Rem Set Input Array
aArySrc = WorksheetFunction.Transpose(.Worksheets("Source").Range("A1:A100"))
Rem Convert values to string
For l = LBound(aArySrc) To UBound(aArySrc)
aArySrc(l) = CStr(aArySrc(l))
Next
Rem Join Array Values
sAryTrg = Join(aArySrc, Chr(133))
Rem Post Resulting Concatenation
.Worksheets("Target").Cells(1).Value = sAryTrg
End With
End Sub
Related
I am writing a little Excel-Macro with VBA. Now I would like to concat two Strings and save them into a String-Array.
What I got:
Dim rowNumberString As String
Dim colIndexString As String
Dim headerArray(1 To colIndexArrayRange) As String
colIndexNumber = 14
colCount = 5
rowNumberString = "12"
addAnotherColumnToArray = True
' Fill the column array with all the month's entries
While addAnotherColumnToArray
colCount = colCount + 1
colIndexNumber = colIndexNumber + 1
If colIndexArray(colCount) = "" Then
colIndexString = Split(Cells(1, colIndexNumber).Address(True, False), "$")(0)
colIndexArray(colCount) = colIndexString & rowNumberString
End If
Debug.Print colCount & "=" & colIndexArray(colCount)
If (colIndexNumber > 61) Then
addAnotherColumnToArray = False
End If
Wend
The output:
6=O
7=P
8=Q
9=R
10=S
11=T
12=U
' ....
So it seems that this line:
` colIndexArray(colCount) = colIndexString & rowNumberString`
is not concatenating the String the way it should. What did I do wrong? I thought the &-Operator would always work for Strings in VBA.
As I stated in my comment, you could be going about this in a completely different way.
Not sure what you are trying to accomplish, but a For...Next statement using Objects, rather than Strings should help you accomplish your task.
Option Explicit
Sub TEST()
Dim ws As Worksheet, Rng12 As Range, Cell As Range
Set ws = ThisWorkbook.Worksheets(1)
Set Rng12 = ws.Range("L12:Z12") 'Adjust your range
For Each Cell In Rng12
Debug.Print Cell.Address
Next Cell
End Sub
I am new to this. I am trying to find the lowest value in a cell with multiple values inside. For example,
48
44.50
41.00
37.50
I am trying to find 37.50. What should be the code for it?
Thanks
Based on your posted example:
Sub FindMin()
Dim s As String, CH As String
Dim wf As WorksheetFunction
Dim bry() As Double
Set wf = Application.WorksheetFunction
s = ActiveCell.Text
CH = Chr(10)
ary = Split(s, CH)
ReDim bry(LBound(ary) To UBound(ary))
For i = LBound(ary) To UBound(ary)
bry(i) = CDbl(ary(i))
Next i
MsgBox wf.Min(bry)
End Sub
This assumes that there is a hard return (ASCII-10) between the fields in the cell.
EDIT#1:
To make it into a function, remove the sub and replace with:
Public Function FindMin(r As Range) As Variant
Dim s As String, CH As String
Dim wf As WorksheetFunction
Dim bry() As Double
Set wf = Application.WorksheetFunction
s = r.Text
CH = Chr(10)
ary = Split(s, CH)
ReDim bry(LBound(ary) To UBound(ary))
For i = LBound(ary) To UBound(ary)
bry(i) = CDbl(ary(i))
Next i
FindMin = wf.Min(bry)
End Function
EDIT#2:
based on your comment, here is an example of input vs output:
Note that all the values are in a single cell and the values are separated by hard returns rather than spaces.
By code with same cell and a " " as delimiter to break
temp = Range("A1").Value
temp = Split(temp, " ")
Low = CInt(temp(0))
For i = 0 To UBound(temp) - 1
If CInt(temp(i)) < Low Then Low = CInt(temp(i))
Next
Range("a2").Value = Low
if they are in a range you can use a formula
=MIN(A1:A4)
This question is pretty close to one previously asked:
VBA/EXCEL: extract numbers from one cell that contained multiple values with comma
If you take the code from that answer and replace the comma with whatever is separating your values, you will be able to get access to them in VBA. Then you can write code to find the minimum.
You can make a macro to split the values for each cell you selected and then check for the highest value. And a quick check to make sure you are not parsing all the empty rows (when you selected a column).
The macro below will set the highest value in the next column.
Sub lowest()
Dim Values As Variant
Dim LowestValue As Double
Dim a As Range
Set a = Selection
For Each Row In a.Rows
For Each Cell In Row.Cells
LowestValue = -1
Values = Split(Cell.Value, Chr(10))
For Each Value In Values
If LowestValue = -1 Then
LowestValue = Value
ElseIf Value < LowestValue Then
LowestValue = Value
End If
Next
Cells(Cell.Row, Cell.Column + 1).Value = LowestValue
If IsEmpty(Cell.Value) Then GoTo EndLoop
Next Cell
Next Row
EndLoop:
End Sub
I need help with excel.
I have a column with hundreds of cells that I need to combine into one cell.
The values in the cells are already centered. Also, some cells have multiple values that are stacked on top of each other using (ALT + ENTER).
I need to choose a range of these cells and combine them and stack them on top of each other into one cell.
If I can also get rid of extra "new lines" between the values as well as repeated values that would be an added bonus.
Here is a picture of what it looks like and what I'm aiming at. I've been trying to learn vbscript and macros, but this is on a bit of a deadline. I appreciate the help.
The following shows you how to combine all numbers from a column into a single cell in VBA Excel, which is what I assume the coding language you are using.
There are two Procedures I use: 1) a columnCombine() Sub and 2) a Custom Split() Function courtesy of Wade Tai of Microsoft
Link to Wade's Article with Split Function: http://msdn.microsoft.com/en-us/library/aa155763%28office.10%29.aspx
columnCombine() Sub:
Sub columnCombine()
'variables needed:
Dim col As Integer
Dim startRow As Integer
Dim endRow As Integer
Dim firstCell As Range
Dim lastCell As Range
Dim i As Integer
Dim s As Variant
Dim destinationCell As Range
Dim strg As Variant
Dim strgTemp() As String
'enter first and last cells of column of interest in the "A1/A2/A3..." format below:'
Set firstCell = Range("A1") 'this can be what you want
Set lastCell = Range("A3") 'this can be what you want
'enter destination cell in same format as above
Set destinationCell = Range("B1") 'this can be what you want
'get column of interest
col = firstCell.Column
'get start row and end row
startRow = firstCell.Row
endRow = lastCell.Row
'set temp string
strg = ""
For i = startRow To endRow
strgTemp = Split(Worksheets("Sheet1").Cells(i, col).Value)
For Each s In strgTemp
If strg = "" Then
strg = s
Else
strg = strg & vbNewLine & s
End If
Next s
Erase strgTemp
Next i
'add column to string
destinationCell.Value = strg
End Sub
Split() Function:
Public Function Split(ByVal InputText As String, _
Optional ByVal Delimiter As String) As Variant
' This function splits the sentence in InputText into
' words and returns a string array of the words. Each
' element of the array contains one word.
' This constant contains punctuation and characters
' that should be filtered from the input string.
Const CHARS = "!?,;:""'()[]{}"
Dim strReplacedText As String
Dim intIndex As Integer
' Replace tab characters with space characters.
strReplacedText = Trim(Replace(InputText, _
vbTab, " "))
' Filter all specified characters from the string.
For intIndex = 1 To Len(CHARS)
strReplacedText = Trim(Replace(strReplacedText, _
Mid(CHARS, intIndex, 1), " "))
Next intIndex
' Loop until all consecutive space characters are
' replaced by a single space character.
Do While InStr(strReplacedText, " ")
strReplacedText = Replace(strReplacedText, _
" ", " ")
Loop
' Split the sentence into an array of words and return
' the array. If a delimiter is specified, use it.
'MsgBox "String:" & strReplacedText
If Len(Delimiter) = 0 Then
Split = VBA.Split(strReplacedText)
Else
Split = VBA.Split(strReplacedText, Delimiter)
End If
End Function
*UPDATE:
If you desire to use this on multiple different columns with the intention of moving everything to one cell, use this code recursively or in some repetitive manner e.g. write a script that uses columnCombine to combine the column sections you are referencing into different cells in one column. Then run the program again (or as many times as you need) so that you get the data into one cell.
If you want to change the order in which you iterate through a column e.g. you want to iterate from A4 to A1 instead of A1 to A4, just change For i = startRow To endRow to For i = endRow To startRow.
Note this will not change the order of organization of data within an individual cell, only a whole column. In other words, {["hello","Hello"],["One"],["Two", "Three"]} would become {["Two","Three"],["One"],["hello","Hello"]}
To change the order within a cell, you would need to either alter the For Each statement in columnCombine() or
manually change the order of strg. Both of which are not to hard to do.
Here is a solution I would do:
Add this in addition to the current variables :
Dim strg2 As Variant
strg2 = ""
Change this code:
For i = startRow To endRow
strgTemp = Split(Worksheets("Sheet1").Cells(i, col).Value)
For Each s In strgTemp
If strg = "" Then
strg = s
Else
strg = strg & vbNewLine & s
End If
Next s
Erase strgTemp
Next i
'add column to string
destinationCell.Value = strg
To:
For i = endRow To startRow
strgTemp = Split(Worksheets("Sheet1").Cells(i, col).Value)
For Each s In strgTemp
If strg = "" Then
strg = s
Else
strg = s & vbNewLine & strg
End If
Next s
If strg2 = "" Then
strg2 = strg
Else
strg2 = strg2 & vbNewLine & strg
End If
strg = ""
Erase strgTemp
Next i
'add column to string
destinationCell.Value = strg2
Remember, this change is specific to iterating through items backward and reordering them backwards. The columnCombine() sub will very depending on how you want the data presented
I want to populate Array in VBA , using for each-loop but unable to do that
Dim MyArray() As Variant
Dim RowCounter As Integer
Dim ColCounter As Integer
Dim rCell As Range
Dim rRng As Range
Set rRng = Sheet1.Range("B10:Z97")
RowCounter = 0
ColCounter = 0
ReDim MyArray(rRng.Rows.Count, rRng.Columns.Count) 'Answer by #varocarbas
For Each rCol In rRng.Columns
For Each rCell In rCol.Rows
If IsNumeric(rCell.Value) And (Not (IsEmpty(rCell.Value))) And (Len(rCell.Value) <> 0) Then
'ReDim Preserve MyArray(RowCounter, ColCounter) -- Old Logic which cause Error
MyArray(RowCounter, ColCounter) = rCell.Value
RowCounter = RowCounter + 1
Else
'Debug.Print rCell.Value & " is not an Integer" & vbNewLine
End If
Next rCell
ColCounter = ColCounter + 1
RowCounter = 0
Next rCol
But ReDim Preserve MyArray(RowCounter, ColCounter) in this line I got subscript error , when ReDim Preserve MyArray(1, 0)
I want to read the value from excel sheet populate the array then do some calculation and update the value of Last Cell of the each Column in Excel from by Calculate Value of the Excel.
Update in code
Function RunSquareOfVariance(temperature As Integer, cellValue As Variant) As Double
RunSquareOfVariance = "=IF((" & temperature + cellValue & ")<0,0,(" & temperature + cellValue & "))*IF((" & temperature + cellValue & ")<0,0,(" & temperature + cellValue & "))"
End Function
If within the code I change the bellow line
MyArray(RowCounter, ColCounter) = RunSquareOfVariance(StantardTemperature, rCell.Value)
Now within MyArray(0,0) Value store As =IF((-16.8)<0,0,(-16.8))*IF((-16.8)<0,0,(-16.8))
But I want to store the value of the formula Withing MyArray(0,0) = ValueOftheFormula
As far as I can remember you can change size ONLY of the last array dimension.
To be sure I've just checked and it's true. According to MSDN:
If you use the Preserve keyword, you can resize only the last array
dimension and you can't change the number of dimensions at all.
I don't know the ultimate goal of your sub therefore is difficult to suggest any changes. However, you could consider working with array of arrays. Syntax of such solution works as follows:
Dim arrA() As Variant
Dim arrB() As Variant
...
ReDim Preserve arrA(RowCounter)
ReDim Preserve arrB(ColCounter)
...
arrA(RowCounter) = x
arrB(ColCounter) = y
...
Dim arrAB
arrAB = Array(arrA, arrB)
...
'to get elements of array you need to call it in this way:
arrAB(0)(RowCounter) >> to get x
arrAB(1)(ColCounter) >> to get y
There are some disadvantages of such solution but could be useful in other situation.
You could do simply:
Dim rng As Range
Dim myArray() As Variant
Set rRng = Sheet1.Range("B10:Z97")
myArray = rRng.Value
You will also need to For Each rCell In rRng.Rows instead of For Each rCell In rCol.Rows. Otherwise, like Kaz says, you can only resize the last dimension of an array.
OK Problem solved
MyArray(RowCounter, ColCounter) = Application.Evaluate
(
RunSquareOfVariance(StantardTemperature, rCell.Value)
)
I can see you have found a solution for your issue. For future reference, I would like to add an alternative way of going about this.
In particular, I agree with #DavidZemens ’s approach on copying the range values to a variant array directly. It is a very elegant, simple and efficient solution. The only tricky part is when there are empty or non-numeric cells in the range you are looking, and you do not want to insert these values. A modification of David’s approach would work in case some of the values you are copying are not numbers.
Sub CopyNumbersToArray()
Dim var As Variant, rng As Range
' Grab the numeric values of the range only. Checking if cell is empty or
' if it has a positive length is not needed
Set rng = Range("B3:K3").SpecialCells(xlCellTypeConstants, xlNumbers)
' Copy the numbers. Note that var=rng.value will not work if rng is not contiguous
rng.Copy
' Paste the numbers temporarily to a range that you do not use
Range("A10000").Resize(1, rng.Count).PasteSpecial xlPasteValues
' Set rng object to point to that range
Set rng = Range(Cells(10000, 1), Cells(10000, rng.Count))
' Store the values that you need in a variant array
var = rng.Value
' Clear the contents of the temporary range
rng.ClearContents
End Sub
For more than 2 dimensions, jagged arrays is probably a good way to go (as suggested by #KazJaw)
I have a spread sheet that look like so:
Group | Name | Title
-----------------------------------
X WS -
X DH -
X M -
X DH -
X WS -
I want to loop through all the cells in name and replace the initial there with their full name in addition to adding the correct title. My script is failing to accurately compare the strings and go into the if-statement:
Sub enterNameAndTitle()
lastCell = InputBox("Last cell")
rInitials = InputBox("Initials")
rFullName = InputBox("Full Name")
rTitle = InputBox("Title")
Dim cell As Range
For Each cell In Range("b2:b" & lastCell).Cells
MsgBox (cell.Text & " : " & rInitials)
If StrComp(UCase(cell.Value), UCase(rInitials)) = 0 Then
cell.Value = rFullName
ActiveSheet.Cells(cell.Row, cell.Column + 1).Value = rTitle
End If
Next cell
End Sub
So I first collect the data and then loop through all the values. Does anyone know what I am doing incorrectly? Why doesn't it compare the string accurately?
I don't see anything wrong, but there are 2 things I would try
One is to use TRIM to make sure neither string has leading or trailing blanks
The 2nd is to change the if to if(ucase(trim(cell.value))=ucase(trim(rInitials)))
The problem was one of differing types and the only way that seemed to work for me was to re-cast both variables as type String using CStr()
Sub enterNameAndTitle()
Dim lastCell As String
lastCell = InputBox("Last cell")
'Cast to string
Dim rInitials As String
rInitials = CStr(InputBox("Initials"))
Dim rFullName As String
rFullName = InputBox("Full Name")
Dim rTitle As String
rTitle = InputBox("Title")
Dim cell As Range
For Each cell In Range("b2:b" & lastCell).Cells
Dim cellText As String
'Cast to string
cellText = CStr(cell.Text)
If (Trim(UCase(cell.Value)) = Trim(UCase(rInitials))) Then
MsgBox ("test1")
cell.Value = rFullName
ActiveSheet.Cells(cell.Row, cell.Column + 1).Value = rTitle
End If
Next cell
End Sub