I have, in the past, used a variant array to populate a range of multiple Excel cells.
I'm wondering, is there a way to do the same thing with cell formatting? I'd rather not go cell by cell, and it'd be nice to minimize the number of calls to get an Excel range...
I mostly do what Lance suggests. However, there are some cases where I will make a separate, hidden worksheet with the formats I want set up. Then I'll
wshHidden.Range("A1:D100").Copy
wshReport.Range("A1:D100").PasteSpecial xlPasteFormats
That takes care of it in one fell swoop. But you do have the overhead of the hidden sheet.
#ExcelHero has pointed out to me how to get this done, so here's how.
If your range is horizontal, then just feed it an array built of Format strings:
[a1:c1].NumberFormat = Array("hh:mm", "General", "$#,##0.00")
If your range is vertical, then transpose that array, since Excel considers Arrays to be horizontal:
[a1:a3].NumberFormat = WorksheetFunction.Transpose(Array("hh:mm", "General", "$#,##0.00"))
Old Answer:
No, you can't do each cell separately, though you can bulk assign one format to an entire range.
The property of a Range to assign to is .NumberFormat. If you create a variant array of strings to assign as a format, then assign it to the range, only the first element gets applied (and it gets applied to all cells of the range).
So the best you can do is loop:
Dim r As Range
Dim v(1 To 3) As Variant
Dim i As Integer
Set r = Range("A1:A3")
v(1) = "hh:mm:ss"
v(2) = "General"
v(3) = "$#,##0.00_);[Red]($#,##0.00)"
For i = 1 to 3
r(i).NumberFormat = v(i)
Next i
Hopefully I can safely presume you are doing this for performance reasons. As answered above, its not really possible the same way you can do with cell contents.
However, if the formatting of cells is often the same as last time you formatted it, it is much faster to first check if the format needs to change, and only then change it.
Here is a function that can do it. In tests (Excel 2003), this runs 8x-10x faster than always setting the format, and that is with screen updating turned off.
Sub SetProperty(ByRef obj As Object, propname, newvalue)
If CallByName(obj, propname, VbGet) <> newvalue Then
Call CallByName(obj, propname, VbLet, newvalue)
End If
End Sub
Call it like this:
Call SetProperty(Cells(1,1).Font, "ColorIndex", 27)
Call SetProperty(Cells(1,1).Borders, "Weight", xlMedium)
etc
Related
I have a column of cells in excel that have the following formatting: "0000.00"
FYI, the quotes are not part of formatting.
Basically, four digits followed by two decimals. However, when the numbers are like "600", they need to be displayed as "0600.00". However, the list of numbers provided to me are displayed that way through formatting, so if I am trying to VLOOKUP, it can't process it; it sees "600", not "0600.00" that is displayed to me.
I am aware of PasteSpecial Paste:=xlPasteValues, but this pastes "600", not the "0600.00" that is displayed to me. Currently I can achieve such results by copying the values and pasting them into notepad —which suggests to me there is a way to do this— but I'd like to create a macro to do this for me.
Sorry for any redundant explanation, just wanted to avoid getting answers relating to pasting values only, which is not what I am looking for.
As you said, to use VLOOKUP with formatted text as the lookup value, you'll need the value of the cell to match with the value of the lookup value, so you'll have to convert the value in the cell to text with something like this (example for a single cell):
Dim rng As Range
Set rng = Range("A1")
rng.PasteSpecial xlPasteFormulasAndNumberFormats
Dim TextValue As String
TextValue = Format(rng, rng.NumberFormat)
rng.NumberFormat = "#" 'We need this line to turn the cell content into text
rng.Value2 = TextValue
I'm pretty sure no PasteSpecial options will allow you to do what you want in a single operation, so this solution is a workaround that does it in two steps.
Multiple cells case:
I realize that the code above doesn't address the issue of pasting multiple cells, so here's a procedure that can be used to copy the formatted number as text from one range to another:
Sub CopyAsFormattedText(ByRef SourceRange As Range, ByRef DestinationRange As Range)
'Load values into an array
Dim CellValues() As Variant
CellValues = SourceRange.Value2
'Transform values using number format from source range
Dim i As Long, j As Long
For i = 1 To UBound(CellValues, 1)
For j = 1 To UBound(CellValues, 2)
CellValues(i, j) = Format(CellValues(i, j), SourceRange.Cells(i, j).NumberFormat)
Next j
Next i
'Paste to destination by using the top left cell and resizing the range to be the same size as the source range
Dim TopLeftCell As Range
Set TopLeftCell = DestinationRange.Cells(1, 1)
Dim PasteRange As Range
Set PasteRange = TopLeftCell.Resize(UBound(CellValues, 1), UBound(CellValues, 2))
PasteRange.NumberFormat = "#" 'We need this line to turn the cells content into text
PasteRange.Value2 = CellValues
End Sub
It's basically the same idea, but with a loop.
Note that if the formatting is always the same, you could make it a variable and apply it to every values in the array instead of calling .NumberFormat on every cell which inevitably adds a little bit of overhead.
Sidenote
One could ask why I'm not suggesting to use :
SourceRange.Cells(i, j).Text
instead of
Format(CellValues(i, j), SourceRange.Cells(i, j).NumberFormat)
And that would be a very good question! I guess, the fact that .Text can return "###..." when the column isn't sized properly always makes me afraid of using it, but it certainly would look much cleaner in the code. However, I'm not sure what would be better in terms of performance. (Relevant article by Charles Williams)
After my formulas and macros run, Im looking to highlight the cells in my worksheet that are outputted as a "" (Result of an If Formula).
It is a dynamic range, and I am having difficulty finding a way to change the color of Just the cells with a space. Any ideas would be very helpful.
Dim cell As Variant
For Each cell In Sheets("[Sheet name here]").UsedRange.Columns("U").Cells
If InStr(cell.Value, "") = 0 Then
cell.Interior.ColorIndex = 15
End If
Next cell
End Sub
Then I basically repeated it for column "D", but it takes an unusually long time to complete...
Im thinking i can implement the
=LEN(??)=0 function, but not sure how to do so...
The reason it is running so slow is that you're calling Excel Object for every cell in your range. If column U has 1,000 cells that aren't empty then that is 1,000 calls to the Excel object model.
It is much faster to read the entire range into memory at one time and then process it in memory. This is very easy to do. The code below reads cells A1:A100 but the key difference is that it only calls the Excel Object one time (instead of 100 times).
Dim MyData As Variant
MyData = Range("A1:A100").Value
For your code you would do something like this ...
Dim MyData As Variant
Dim i As Long
MyData = ActiveSheet.UsedRange.Columns("U").Cells.Value
For i = 1 To UBound(MyData)
If (MyData(i, 1) = "") Then
'keep track of which cells need to be colored
End If
Next
If you have a lot of cells that need coloring, you will need to use a "non-contiguous" range selecting in order to perform this with one call to Excel's object model. See this article for more information Using VBA to select non-adjacent range
Thanks all. In this instance, I ended up modifying my formulas to actually generate a space " " instead of a null string, "" as #Scott Craner pointed out.
With a legitimate space, I just achieved the same results using conditional formatting, as #tigeravatar suggested.
Thank you all for the help, I really appreciate it !
What I am doing is very simple - selecting a union of columns which contain numbers stored as text and converting them. Every time this runs, all even union numbered columns of data are getting cleared.
Union(Columns(19), Columns(22), Columns(25), Columns(28), Columns(31), Columns(34), Columns(37), Columns(40), Columns(43), Columns(46)).Select
With Selection
.Value = .Value
End With
I've looked though my entire code multiple times are cant figure why this is behaving so weird. any help is greatly appreciated.
The Value property of a discontiguous range only returns the first area of that range. When you then try and assign that value (array, in this case) back to a discontiguous range, you get strange results. For this particular case, every second column will get the value of the first cell in the first area.
You should loop through the areas in your range.
For each rArea in Selection.Areas
rarea.value2 = rarea.value2
Next rarea
Try to avoid using Select, and fully qualify your ranges. This makes things easier to diagnose and more robust...
Dim myRange As Range
With ThisWorkbook.Sheets("Sheet1")
Set myRange = Union(.Columns(19), .Columns(22), .Columns(25)) ' etc.
End With
Now if you're trying to convert text to numbers, you might be better off using the NumberFormat property as discussed here: What are .NumberFormat Options In Excel VBA?
Looping through range areas and number-formatting:
Dim area As Range
For Each area In myRange.Areas
area.NumberFormat = 0 ' for numbers, could still use area.Value = area.Value
Next area
I need to extract the data from an excel worksheet to an array that will be used in an application that uses VBScript as scripting language (Quick Test Professional). We can use the following code for that:
' ws must be an object of type Worksheet
Public Function GetArrayFromWorksheet(byref ws)
GetArrayFromWorksheet = ws.UsedRange.Value
End Function
myArray = GetArrayFromWorksheet(myWorksheet)
MsgBox "The value of cell C2 = " & myArray(2, 3)
All nice and well, but unfortunately the array that gets returned does not only contain the literal text strings, but also primitives of type date, integer, double etc. It happened multiple times that that data got transformed.
[edit] Example: when entering =NOW() in a cell and set the cell formatting to hh:mm makes the displayed value 17:45, the above method retuns a variable of type double and a value like 41194.7400990741
The following solution worked better: I can get the literal text from a cell by using the .Text property, but they only work on one cell and not on a range of cells. I cannot do this at once for an array as I could with the .Value property, so I have to fill the array one cell at a time:
Public Function GetArrayFromWorksheet_2(byref ws)
Dim range, myArr(), row, col
Set range = ws.UsedRange
' build a new array with the row / column count as upperbound
ReDim myArr(range.rows.count, range.columns.count)
For row = 1 to range.rows.count
For col = 1 to range.columns.count
myArr(row, col) = range.cells(row, col).text
Next
Next
GetArrayFromWorksheet_2 = myArr
End Function
But ouch... a nested for loop. And yes, on big worksheets there is a significant performance drop noticable.
Does somebody know a better way to do this?
As we covered in the comments, in order to avoid the issue you will need to loop through the array at some point. However, I am posting this because it may give you a significant speed boost depending on the type of data on your worksheet. With 200 cells half being numeric, this was about 38% faster. With 600 cells with the same ratio the improvement was 41%.
By looping through the array itself, and only retrieving the .Text for values interpreted as doubles (numeric), you can see speed improvement if there is a significant amount of non-double data. This will not check .Text for cells with Text, dates formatted as dates, or blank cells.
Public Function GetArrayFromWorksheet_3(ByRef ws)
Dim range, myArr, row, col
Set range = ws.UsedRange
'Copy the values of the range to temporary array
myArr = range
'Confirm that an array was returned.
'Value will not be an array if the used range is only 1 cells
If IsArray(myArr) Then
For row = 1 To range.Rows.Count
For col = 1 To range.Columns.Count
'Make sure array value is not empty and is numeric
If Not IsEmpty(myArr(row, col)) And _
IsNumeric(myArr(row, col)) Then
'Replace numeric value with a string of the text.
myArr(row, col) = range.Cells(row, col).Text
End If
Next
Next
Else
'Change myArr into an array so you still return an array.
Dim tempArr(1 To 1, 1 To 1)
tempArr(1, 1) = myArr
myArr = tempArr
End If
GetArrayFromWorksheet_3 = myArr
End Function
Copy your worksheet into a new worksheet.
Copy Paste values to remove formulas
Do a text to columns for each column, turning each column into Text
Load your array as you were initially doing
Delete the new worksheet
You cant do this quickly and easily without looping through the worksheet.
If you use the technique above with 2 lines of code it must a variant type array.
I've included a real example from my code that does it in 6 lines because I like to A) work with the worksheet object and B) keep a variable handy with the original last row.
Dim wsKeyword As Worksheet
Set wsKeyword = Sheets("Keywords")
Dim iLastKeywordRow As Long
iLastKeywordRow = wsKeyword.Range("A" & wsKeyword.Rows.Count).End(xlUp).Row
Dim strKeywordsArray As Variant
strKeywordsArray = wsKeyword.Range("A1:N" & iLastKeywordRow).Value
Note your array MUST be a variant to be used this way.
The reason that Variants work like this is that when you create an array of variants, each 'cell' in the array is set to a variant type. Each cell then get's it's variant type set to whatever kind of value is assigned to it. So a variant being assigned a string gets set to variant.string and can now only be used as a string. In your original example it looks like you had time values which were kind of stored as variant.time instead of variant.string.
There are two ways you can approach your original problem
1) loop through and do the process with more control, like the double nested for loop. explained in another answer which gives you complete control
2) store all the data in the array as is and then either re-format it into a second array, or format it as desired text as you use it (both should be faster)
Let's say I have a range called rng1
Set rng1 = Worksheets("Sheet1").Range("A1","A5")
Is there a quick and easy way to perform a mathematical function, lets say divide all those cell values by 2, for all the cells in rng1?
Any help is appreciated!
It's very easy, but the final code will depend on where you want to store the new values. For example, if you want to store the values divided by 2 in the next column:
Sub test()
Dim cell As Range
For Each cell In Range("A1:A5")
cell.Offset(, 1).Value = cell.Value / 2
Next
End Sub
Mind you there are more efficient ways to do this than using offset if your range is large, but for a smaller range, this is totally acceptable and fast.
If you want to overwrite the values, you can simply use cell.Value in place of cell.Offset(,1).Value
Another Way
Sub Main()
[B1:B5] = [INDEX((A1:A5/2),)]
End Sub
How it works is well explained here.