Get formatted values from a multi-cell range - vba

Dim myText As String
myText= Range("a3").Text
Returns the formatted value in cell A3, but
myText= Range("a3:c7").Text
gives me an error.
How do I get strings representing formatted values from a multi-cell range, while preserving the number format? i.e. the format of the output text would be the same as if copy-pasting from the range to a text editor.

The only way to get multiple cell values into an array with one single statement (no loops) is with a Variant array.
Dim varItemName As Variant
varItemName = Range("a3:c7")
If you really absolutely need the names to be type String, then just CStr them later when you use them.
output = FunctionRequiringStringArgument(CStr(varItemName(1,2))
EDIT: Okay, okay, you want strings with same format as in sheet.
Here's a full working example.
Dim strMyFormat1 As String
Dim varItemName As Variant
Dim strItemName() As String
Dim strItemNameBF() As String
Dim iCol As Long
Dim iRow As Long
Dim rngMyRange As Range
Set rngMyRange = Range("A3:C7")
varItemName = rngMyRange
ReDim strItemName(LBound(varItemName, 1) To UBound(varItemName, 1), _
LBound(varItemName, 2) To UBound(varItemName, 2))
'// Take a sample of the format
strMyFormat1 = Range("A3").NumberFormat
'// Apply format sample to all values
For iRow = LBound(varItemName, 1) To UBound(varItemName, 1)
For iCol = LBound(varItemName, 2) To UBound(varItemName, 2)
strItemName(iRow, iCol) = Format(varItemName(iRow, iCol), strMyFormat1)
Next iCol
Next iRow
'// Can also apply to only some values -- adjust loops.
'// More loops go here if many format samples.
'// If all cells have different formats, must use brute force -- slower.
ReDim strItemNameBF(1 To rngMyRange.Rows.Count, _
1 To rngMyRange.Columns.Count)
For iRow = 1 To rngMyRange.Rows.Count
For iCol = 1 To rngMyRange.Columns.Count
strItemNameBF(iRow, iCol) = rngMyRange.Cells(iRow, iCol).Text
Next iCol
Next iRow

For Each c In Range("a3:c7")
ItemName = c.Text
Next c
This will give you each cell one after the other.

This is a modified version of one of the post here and it worked for me.
Function Range2Text(ByVal my_range As Range) As String
Dim i As Integer, j As Integer
Dim v1 As Variant
Dim Txt As String
v1 = my_range
For i = 1 To UBound(v1)
For j = 1 To UBound(v1, 2)
Txt = Txt & v1(i, j)
Next j
Txt = Txt & vbCrLf
Next i
Range2Text = Txt
End Function

Make a collection and run through all the Areas of the range and collect the text into
the collection.

dim i as integer, j as integer
Dim v1 as variant
v1=range("a3:c7")
for i=1 to ubound(v1)
for j=1 to ubound(v1,2)
debug.print v1(i,j)
next j
next i

Related

VBA Looping through single row selections and executing concat code

So, I've been scratching my head for a couple of hours now trying to figure this out. No matter where I look and what I do, I can't seem to make it work.
I have an excel document with ~20 columns and a completely variable number of rows. I want to concatenate each adjacent cell within the defined width (columns A:V)into the first cell (A1 for the first row), and then move to the next row and do the same until I get to the bottom. Snippet below:
Example before and after I'm trying to make
I have the code that does the concatenation. To make it work I have to select the cells I want to concatenate (A1:V1), and then execute the code. Even though some cells are blank, I need the code to treat them this way and leave semicolons there. The code works exactly as I need it to, so I've been trying to wrap it in some sort of Range select, offset, loop:
Dim c As Range
Dim txt As String
For Each c In Selection
txt = txt & c.Value & ";"
Next c
Selection.ClearContents
txt = Left(txt, Len(txt) - 2)
Selection(1).Value = txt
What I am struggling with is making the selection A1:V1, running the code, and then looping this down to A2:V1, A3:V3, etc. I think this can be done with a loops and an offset, but I cannot for the life of me work out how.
Any help at all would be much appreciated :)
This uses variant Arrays and will be very quick
Dim rng As Range
With Worksheets("Sheet4") 'change to your sheet
'set the range to the extents of the data
Set rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 22).End(xlUp))
'Load data into an array
Dim rngArr As Variant
rngArr = rng.Value
'create Out Bound array
Dim OArr() As Variant
ReDim OArr(1 To UBound(rngArr, 1), 1 To 1)
'Loop array
Dim i As Long
For i = LBound(rngArr, 1) To UBound(rngArr, 1)
'Combine Each Line in the array and load result into out bound array
OArr(i, 1) = Join(Application.Index(rngArr, i, 0), ";")
Next i
'clear and load results
rng.Clear
rng.Cells(1, 1).Resize(UBound(OArr, 1)).Value = OArr
End With
Here's a quick little script I made up to do this - the main thing to note is that I don't use selection, I used a defined range instead.
Sub test()
Dim i As Long
Dim target As Range
Dim c As Range
Dim txt As String
For i = 3 To 8
Set target = Range("A" & i & ":C" & i)
For Each c In target
txt = txt & c.Value & ";"
Next c
Cells(i + 8, "A").Value2 = Left$(txt, Len(txt) - 1)
txt = ""
Next i
End Sub
Just change the range on the below to your requirements:
Sub concat_build()
Dim buildline As String
Dim rw As Range, c As Range
With ActiveSheet
For Each rw In .Range("A2:V" & .Cells(.Rows.Count, "B").End(xlUp).Row + 1).Rows
buildline = ""
For Each c In rw.Cells
If buildline <> "" Then buildline = buildline & ";"
buildline = buildline & c.Value2
Next
rw.EntireRow.ClearContents
rw.EntireRow.Cells(1, 1) = buildline
Next
End With
End Sub

Define array to obtain data from range as "double" var type

I'm fairly new to VBA, so please bear with me.
I want to tell VBA to get an array from a range of cells. The user will paste a column of data into cell C2 so cells below C2 will be populated. The number of cells populated is up to the user.
I am also going to need each of the elements in the array to be taken as doubles as I'm going to make operations with them.
Therefore if the list is
1.2222
2.4444
3.5555
Then I need the array to preserve the decimal points.
How do I do this?
This is what I've got this fur, with no luck:
Set ThisWS = Excel.ActiveWorkbook.Worksheets("Hoja1")
Dim InputValues() As Double 'Define Array
Dim LRow As Long 'Define length of array
With Sheets("Hoja1")
LRow = .Range("C" & .Rows.count).End(xlUp).Row
End With
InputValues = ThisWS.Range("C2:C" & LRow).Value 'Error 13: data type doesn't match
End Sub
Thanks!
Excel.ActiveWorkbook. isn't needed in Excel, it is implied. I didn't need to type cast the cell value CDbl(.Cells(x, "C")).
Sub Example()
Dim InputValues() As Double
Dim lastRow As Long, x As Long
With Worksheets("Hoja1")
lastRow = .Range("C" & .Rows.Count).End(xlUp).Row
ReDim InputValues(lastRow - 2)
For x = 2 To .Range("C" & .Rows.Count).End(xlUp).Row
InputValues(x - 2) = CDbl(.Cells(x, "C"))
Next
End With
End Sub
This example is more efficient but won't make a noticeable difference unless you are working with a very large amount of data.
Sub Example2()
Dim InputValues() As Double, vInputValues As Variant
Dim x As Long
With Worksheets("Hoja1")
vInputValues = .Range("C2", .Range("C" & .Rows.Count).End(xlUp)).Value2
ReDim InputValues(UBound(vInputValues) - 1)
For x = 1 To UBound(vInputValues)
InputValues(x - 1) = CDbl(vInputValues(x, 1))
Next
End With
End Sub
Set ThisWS = Excel.ActiveWorkbook.Worksheets("Hoja1")
Dim CurRow As Long
Dim LRow As Long 'Define length of array
LRow = ThisWS.Range("C" & Rows.count).End(xlUp).Row
Dim InputValues(1 to LRow - 1) As Double 'Define Array
For CurRow = 2 to LRow
InputValues(CurRow - 1) = ThisWS.Range("C" & CurRow).Value
Next CurRow
End Sub
you can simply go like follows
Option Explicit
Sub main()
Dim InputValues As Variant 'Define Array
With Excel.ActiveWorkbook.Worksheets("Hoja1") ' refer to wanted worksheet
InputValues = .Range("C2", .Cells(.Rows.Count, 3).End(xlUp)).value 'fill array with values in column "C" cells from row 2 down to last non emtpy one
End With
End Sub
should you ever need to handle array values as of Double type, then you can use CDbl() function
In VBA you can assign .Value and .Value2 arrays only to a Variant
As a side note if the range is formated as table, you can just do something like
Dim InputValues() ' As Variant by default
InputValues = [transpose(Hoja1!Table1[Column3])] ' Variant(1 to number of rows in Table1)

Using MONTH in If statement in Excel VBA

I'm trying to write an Excel macro that will look at the dates in column A and print each month listed in a column F. I am trying to use a for loop and If/Else statements but I can't seem to get it to work out correctly.
y = 2
Range("F2").Formula = "=MONTH(A3)"
For x = 4 To RowLast - 1
If Range("A" & x).Month = Range("F" & y) Then
Else
y = y + 1
Range("F" & y).Formula = "=MONTH(A" & x & ")"
End If
Next
That is what I have thus far and it should print the first month found in Cell A3 to Cell F2 (which works), then go through every other date until it hits one line above the last. The if statements should check to make sure it's a new month and if it is print the month to the next cell in column F.
Please let me know if you have any questions. Thank you.
I think your if statement is causing the problems. Do you even need an if statement here if you are just printing the month?
RowLast = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
y = 2
Range("F2").Formula = "=MONTH(A3)"
For x = 4 To RowLast - 1
Range("Z2").Formula = "=MONTH(A" & x & ")"
If Range("Z2").Value = Range("F" & y).Value Then
Else
y = y + 1
Range("F" & y).Formula = "=MONTH(A" & x & ")"
End If
Next
To answer your specific question: Month(date) is a function that returns an integer corresponding to the month of the date argument. So Month(Now) would return 3, for example.
.Month is not a property of the .Range object so your code would throw an error ("Object doesn't support this property or method"). The code below shows how to use the Month() function in the way you want.
However, your code poses a wider question. Are you using VBA merely to automate your formula writing? If you are, then all well and good. But is it possible that you are using worksheet functions when, actually, VBA would serve you better? Is there a reason, for example, that you would use VBA to identify target months only to write those target months to your worksheet by way of an Excel formula?
I mention it because quite a few posts recently have limited their scope to how to automate Excel functions (probably as a result of recording macros) whereas VBA can be more capable than their imagination might allow.
Anyhow, here are two very similar versions of the same task: the first that writes the formulae and the second that writes the months. I hope it'll provoke some thought as to which automation type suits your needs:
Code to write the formulae:
Public Sub FormulaGenerator()
Dim ws As Worksheet
Dim firstRow As Long
Dim lastRow As Long
Dim dateRange As Range
Dim cell As Range
Dim hitList As Collection
Dim refMonth As Integer
Dim thisMonth As Integer
Dim r As Long
Dim output() As Variant
Dim item As Variant
'Set these for your own task.
Set ws = ThisWorkbook.Worksheets("Sheet1")
firstRow = 3
lastRow = 20
'Read the values cell by cell
Set dateRange = ws.Range(ws.Cells(firstRow, "A"), ws.Cells(lastRow, "A"))
Set hitList = New Collection
For Each cell In dateRange.Cells
item = cell.Month
thisMonth = Month(cell.Value)
If thisMonth <> refMonth Then
'It's a new month so populate the collection with the cell address
hitList.Add cell.Address(False, False)
refMonth = thisMonth
End If
Next
'Populate the output array values
ReDim output(1 To hitList.Count, 1 To 1)
r = 1
For Each item In hitList
output(r, 1) = "=MONTH(" & item & ")"
r = r + 1
Next
'Write the output array starting at cell "F2"
ws.Cells(2, "F").Resize(UBound(output, 1)).Formula = output
End Sub
Code to write the months as integers:
Public Sub OutputGenerator()
Dim ws As Worksheet
Dim firstRow As Long
Dim lastRow As Long
Dim dates As Variant
Dim hitList As Collection
Dim refMonth As Integer
Dim thisMonth As Integer
Dim r As Long
Dim output() As Integer
Dim item As Variant
'Set these for your own task.
Set ws = ThisWorkbook.Worksheets("Sheet1")
firstRow = 3
lastRow = 23
'Read the dates into an array
dates = ws.Range(ws.Cells(firstRow, "A"), ws.Cells(lastRow, "A")).Value
'Loop through the array to acquire each new date
Set hitList = New Collection
For r = 1 To UBound(dates, 1)
thisMonth = Month(dates(r, 1))
If thisMonth <> refMonth Then
'It's a new date so populate the collection with the month integer
hitList.Add thisMonth
refMonth = thisMonth
End If
Next
'Populate the output array
ReDim output(1 To hitList.Count, 1 To 1)
r = 1
For Each item In hitList
output(r, 1) = item
r = r + 1
Next
'Write the output array starting at cell "F2"
ws.Cells(2, "F").Resize(UBound(output, 1)).Value = output
End Sub

Quickly filling up excel cells from a Array

I generate arrays from a external data tool and now want to fill the cells up using the data in the arrays. I have written the following code.
With ThisWorkbook.Worksheets("Data")
Lastrow = .Cells(.Rows.count, 2).End(xlUp).Row
For i = LBound(Price) To UBound(Price)
.Cells((Lastrow + 1), 1) = Price(i)
.Cells((Lastrow + 1), 2) = Quantity(i)
Lastrow = Lastrow + 1
Next i
End With
All the arrays are of same length and I have around 25 odd arrays to work with. The code works fine but the problem I am facing is of speed. It takes me around 5-6 hours to fill the sheet once with around 3000 as the length of array. Please suggest your best way. Thank you.
Here is an example of how to populate to a range from an array without looping:
Sub PopulateFromArray()
Dim MyArr As Variant
MyArr = Array("Hello", "World", "This is some", "Text")
Range("A1").Resize(UBound(MyArr) + 1, 1).Formula = Application.Transpose(MyArr)
End Sub
We are using resize to resize the range to populate using the upper boundary of the array. We add one to it because it is option base 0. We transpose the array because by the nature of an array the data goes across and we need it to go down. If we wanted to span columns instead of rows we would need to double transpose it like this:
Application.Transpose(Application.Transpose(MyArr))
With ThisWorkbook.Worksheets("Data")
NextRow = .Cells(.Rows.count, 2).End(xlUp).Row + 1
num = UBound(Price) - LBound(Price)
.Range(.Cells(NextRow, 1), .Cells(NextRow + num, 1)) = Application.Transpose(Price)
.Range(.Cells(NextRow, 2), .Cells(NextRow + num, 2)) = Application.Transpose(Quantity)
End With
you can dump an array to a worksheet range very simply like this:
range("A1:B5").value = myArray
you can populate an array conversly:
dim myArray as variant
myArray = range("A1:B5").value
I use this method very frequently, I hardly ever work with data on a worksheet, I prefer to take it into an array first then work with the array.
You have number of arrays (25) with different data (e.g. Price, Quantity, SomeOtherArray) as per your question. As per my comment above.
Option Explicit
Public Sub GetData()
Dim ws As Worksheet
Dim LastRow As Long
Dim arrPrice As Variant
Dim arrQty As Variant
Set ws = Sheets(3)
'-- starts at zero index
arrPrice = Array(50, 60, 70, 75)
arrQty = Array(250, 100, 50, 200)
'-- change columns as per your needs
LastRow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
'-- UBound + 1 is because the array starts at zero index above
ws.Range("B1").Offset(LastRow).Resize(UBound(arrPrice)+1).Value = Application.Transpose(arrPrice)
ws.Range("B1").Offset(LastRow, 1).Resize(UBound(arrQty)+1).Value = Application.Transpose(arrQty)
End Sub
To fill a range of N rows by M columns, put the data into a 2-dimensional array of the same size, then assign that array to the Value property of the range.
ReDim varValues(1 To lngRowCount, 1 To lngColCount)
Or
ReDim varValues(0 To lngRowCount - 1, 0 To lngColCount - 1)
I presume you can handle populating the array. Then:
Set rngTheRange = 'I presume you can handle this, too
rngTheRange.Value = varValues
Here is an example that uses this technique to fill the current selection with values 0 through N - 1, where N is the number of cells in the selection:
Option Explicit
Public Sub X()
Dim rngCurrent As Range
Dim lngRows As Long
Dim lngCols As Long
Dim lngR As Long
Dim lngC As Long
Dim varValues() As Variant
Set rngCurrent = Selection
lngRows = rngCurrent.Rows.Count
lngCols = rngCurrent.Columns.Count
ReDim varValues(0 To lngRows - 1, 0 To lngCols - 1) As Variant
For lngR = 0 To lngRows - 1
For lngC = 0 To lngCols - 1
varValues(lngR, lngC) = lngR * lngCols + lngC
Next
Next
rngCurrent.Value = varValues
End Sub

Excel range to plane string

I am trying to read an Excel range to a variable of type string.
Currently I have achieved it with a work around. I copied the range to clipboard and used a ReadClipBoard function that reads the clipboard as assigns to variable. This method is not efficient and also some times it gives error due to clipboard issues with VBA.
Workaround Code:
Dim variable as string
Range("A1:C5").Copy
variable = ReadClipBoard()'Function that returns clipboard text
Is there a better way to do it?
This will turn each line into a tab-separated string and the whole range into a line-separated string.
Public Function RangeToText(ByRef r As Range)
Dim vaData As Variant
Dim aOutput() As String
Dim i As Long
Dim wf As WorksheetFunction
Set wf = Application.WorksheetFunction
'Put range into a two dim array
vaData = r.Value
'Make one dim array the same number of rows
ReDim aOutput(1 To UBound(vaData, 1))
'Make strings With tabs out of each row
'and put into one dim array
For i = LBound(vaData, 1) To UBound(vaData, 1)
aOutput(i) = Join(wf.Index(vaData, i), vbTab)
Next i
'join all the strings into one multi-line string
RangeToText = Join(aOutput, vbNewLine)
End Function
In the Immediate Window
?rangetotext(sheet1.Range("A1:C5"))
Here Here Here
is is is
some some some
column 1 column 2 column 3
text text text
The Index worksheet function is used to process only one row at a time because Join requires a one dimensional array
If you are reading more than once cell, then the variable would be an array For example:
Sub ArrayDemo()
Dim r As Range
Set r = Range("A1:C5")
variable = r
End Sub
is nearly equivalent to :
Sub ArrayDemo2()
Dim r As Range
Set r = Range("A1:C5")
Dim variable(1 To 5, 1 To 3) As Variant
For i = 1 To 5
For j = 1 To 3
variable(i, j) = Cells(i, j).Value
Next j
Next i
End Sub
Naive way is to concatenate all the content into a string, is that ok for you?
Function ConcatCells(r as range, optional sep as string) as string
dim c as range
dim s as string
s=""
if sep is missing then sep=" "
for each c in r.cells
s = s & c & sep
next c
s=left(s, len(s) - len(sep))
ConcatCells=s
end sub