Excel VBA - Performing function to each cells in range - excel

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.

Related

Pasting Values as Displayed

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)

Selecting an area with exception of merged cells in dynamic range

IMPORTANT EDIT: The main issue here is caused by hidden merged cells that are causing the entirity of their active range to be selected. Unless you know a way how to dynamically skip merged cells (in a dynamic range), the it most likely won't help. Have changed the entirity of question accordingly
any idea what am I doing wrong?
Got the following code, fyi the function find_last_row returns the value of last active row as integer. In this case, the returned variable would be 40
Private Sub initalize_button_Click()
Dim lastRow As Integer
Dim ws As Worksheet: Set ws = Sheets("Training_Planner")
lastRow = find_last_row
With ws
.Activate
.Range("E5:H" & lastRow).Select
End With
End Sub
Pretty basic code, should open the worksheet Training_Planner and select from E5 to HlastRow (in this case lastRow is 40) so the selected range should be E5:H40
Here is the expected result:
What I get instead:
Curiously enough, it selects only active range, but it's as if it didn't pay attention to columns, instead of the expected E5:H40 i get B5:I40
Any idea what's causing this?
Ok, first of all, if your range is gonna start always as E5, your range is 50% dinamic, because it starts always in same column and same row. Your Range is (Cells(a,b),Cells(c,d)), this means a = 5 and b = 5 (Column E).
Also, you say and Inputbox asks users for end cell of range (in your example is H40, but this is dynamic).
So, my code checks EVERY SINGLE cell in the range formed, and then, using Application.UnionI set a final big range. We cannot just use an array to select all of them, because your range is dynamic, and selecting ranges with arrays is limited to 30 args, so we need to update our FinalRange for each cell.
Dim MyCell As Range
Dim RangeWanted As Range
Dim MyFinalRange As Range
Set RangeWanted = Range("E5:" & InputBox("Cell Address")) 'User inputs Final Cell of Range. Start is always E5
'let's get all invididual addresses of each cell inthat dynamic RangeWanted
For Each MyCell In RangeWanted
If MyCell.MergeCells = False Then 'If not merged, we add it to FinalRange
If MyFinalRange Is Nothing Then
Set MyFinalRange = MyCell
Else
Set MyFinalRange = Application.Union(MyFinalRange, MyCell)
End If
End If
Next MyCell
Set RangeWanted = Nothing
MyFinalRange.Select
With this code, from Range("E5:H40") in image,yellow cells are merged. I want to select only the not merged ones. And using this code, I get this:
My example is with Range("E5:H40") but it works also with other ranges.
Try it and adapt the code to your needs.
Whenever something small like this is happening, simply try to simplify as much as you can. In your case, it would be this:
Sub TestMe()
Worksheets("Training_Planner").Range("E5:H40").Select
End Sub
If it selects E5:H40 then everything is ok. If not, try to select it manually. Probably you have a hidden row, which is merged from B to I, thus it is happenning this way.
Instead of this:
.Range("E5:H" & lastRow).Select
Try going with this:
.Range("E5", (Cells(Rows.Count, "H").End(xlUp))).Select
It count all the rows "H" has and then goes up until it finds the first item. And it will then select from "E1" to last item in "H"

VBA WorksheetFunction dynamic randbetween

hope all is well.
I am slightly stuck on a VBA function called randbetween in Excel.
Nature of the problem is that I need to create random numbers based on a bunch of other numbers, about 50,000 other numbers in total.
The random numbers I generate must be between 1 and X. X being the other numbers in column D1:D50,000.
As an example: if cell D1 contains the number 5, then I need to create a random number between 1 and 5 in Cell A1. then move on to D2,D3,D4.....etc and create random numbers for each one accordingly, A2,A3,A4...etc.
I tried to use the following but unfortunately the offset part doesn't work. I want to dynamically work through each cell.
the code is as follows:
r = WorksheetFunction.RandBetween(1, Offset(A1, n, 9))
'where n = 2
Most grateful for any help,
Your use of OFFSET is the wrong syntax. You would need somthing like
Range("A1").Offset(RowOffset, ColumnOffset)
But there is a much better approach to achieve your stated goal. Use Range.FormulaR1C1
Sub Demo()
Dim rng As Range
' Define range
Set rng = [A1:A50000]
' Put formulas into the range
rng.FormulaR1C1 = "=RANDBETWEEN(1,RC4)"
'optional, replace formulas with values
rng.Value = rng.Value
End Sub

Perform a function on values in multiple columns based on value in one cell using VBA

I have a sheet of data and am attempting to check column E10 TO I610 to see if the values in there are more than 11538 and the value in cell J5 is "weekly". If the conditions are true, add the values that are more than 11538 and multiply them by 8.4. How do I go about doing this?
Not too strong with vba so please bear with me.
If schedType = "Weekly" And Range("E10,I610").Value > 11538 Then
Range("H6").Value = "WOW"
ElseIf schedType = "Monthly" Then
Range("H6").Value = "10"
End If
I tried the above way to achieve what I want. Though the code above wont do the exact calculations im after, its just a test. Like I said, I'm attempting to search the range E10 to I610 for any values greater than 11538, then total them and finally find 8.4% of the total.
Its a bit complicated and any assistance is greatly appreciated.
This doesn't work for a lot of reasons, not the least of which is this:
Range("E10,I610").Value
For starters, Range("E10,I610") is a range of only two cells, you guessed it: E10 and I10. Use a colon to create a continuous range object, Range("E10:I610"). Furthermore, the .Value property of a multi-cell range will always, only return the value in the top, left cell.
So, since the value of E10 was not > 11538, the first If statement returns False, and the rest of your code within that block is omitted.
Then, it will continues to fail because you have not structured the code correctly.
There are several ways to work with multiple cells/ranges, I will give you one example which is not very efficient, but it will work for your purposes. I will use a For each loop to iterate over every cell in the Range("E10:I610"), and then check those values against 11538, summing the values greater than 11538.
Sub TotalCells()
Dim schedType as String
Dim rng as Range
Dim cl as Range
Dim myTotal as Double
Set rng = Range("E10:I610")
schedType = Range("J5").Value
'## Check what schedType we are working with:
If schedType = "Weekly" Then
For each cl in rng.Cells
If cl.Value > 11538 Then myTotal = myTotal + cl.Value
Next
'## Multiply the sum by 8.4%
myTotal = 0.084 * myTotal
'## Display the result:
MsgBox "The weekly total is: " & myTotal, vbInformation
ElseIf schedType = "Monthly" Then
' You can put another set of code here for Monthly calculation.
End If
## Print the total on the worksheet, cell H6
Range("H6").Value = myTotal
End Sub
As I said, this is not efficient, but it illustrates a good starting point. You could also use formulas like CountIfs or SumIfs or use the worksheet's AutoFilter method and then sum the visible cells, etc.
In the future, it is always best to post all, or as much of your code as possible, including the declaration of variables, etc., so that we don't have to ask questions like "What type of variable is schedType?"

Set Excel Range Formatting With Array

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

Resources