I'm surprised there aren't really any great ways to multiply a Range by a constant value. Sure you can use a loop, but that seems pretty long-winded for something that seems so simple. You can also use the Evaluate statement, but the information page is so vague on what this actually does, so I would rather not. That leaves us with the PasteSpecial method, which for some reason forces the active cell to change. This is annoying, because if you want to keep the activecell default on the page you're pasting it onto, you now have to add 4 lines of code to achieve it.
Before:
Sub sq()
Range("A1").Copy
Sheets(2).Range("F1:F20").PasteSpecial xlPasteValues, xlPasteSpecialOperationMultiply
Application.CutCopyMode = False
End Sub
After:
Sub sq()
Sheets(1).Range("A1").Copy
Sheets(2).Activate
adr = ActiveCell.Address
Sheets(2).Range("F1:F20").PasteSpecial xlPasteValues, xlPasteSpecialOperationMultiply
Application.CutCopyMode = False
Sheets(2).Range(adr).Select
Sheets(1).Activate
End Sub
Is this the generally accepted method of simply multiplying a range by a value or am I unaware of something else?
If you are looking for a 'cool' method of applying a Paste Special, Multiply to a range of cells without using .Select, consider adding a UDF to your project.
Sub sq()
Dim rMultiplier As Double
With Worksheets(1)
rMultiplier = .Range("A1").Value2
End With
With Worksheets(2).Range("F1:F20")
.Cells = udfPasteSpecialMultiply(.Cells, rMultiplier)
End With
With Worksheets(2).Range("H2:K2")
.Cells = udfPasteSpecialMultiply(.Cells, rMultiplier)
End With
End Sub
Function udfPasteSpecialMultiply(rng As Range, dMult As Double)
Dim v As Long, w As Long, vVALs As Variant
vVALs = rng.Value2
For v = LBound(vVALs, 1) To UBound(vVALs, 1)
For w = LBound(vVALs, 2) To UBound(vVALs, 2)
vVALs(v, w) = vVALs(v, w) * dMult
Next w
Next v
udfPasteSpecialMultiply = vVALs
End Function
The User Defined Function returns an array of modified values that are stuffed back into the cells after performing the equivalent of a [Range.PasteSpecial method] with the xlPasteSpecialOperationMultiply operation. No change to the selection or active cell on either worksheet is made.
In all fairness, you really shouldn't be relying on .Select, .Activate, ActiveCell or Selection to reference cells. As your coding skills develop these cell reference problems are going to get worse; not better. See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.
Related
I have a rather simple vba script that copies trasposed values from a range in a sheet to another, here is the relevant code:
wb.ActiveSheet.Range("D2", "D32").Copy
cwb.ActiveSheet.Range("B10").PasteSpecial Paste:=xlPasteValues, Transpose:=True
The source range is unformatted text (no control over this) but it is a time (xx:xx) while the destination is appropriately pre-formatted as a time (xx:xx).
It seems that the values in the destination range are treated as plain strings as opposed to being formatted according to the specified rule. As soon as I select a cell and press enter the formatting is applied.
How can I trigger the same behavior right when I'm pasting the range in vba?
The user shouldn't be required to confirm every cell.
I should add that this causes some calculations to fail, too, because to excel those are not numbers.
In your case the regular Copy >> PasteSpecial will not work, you need to convert a time entered as a String to time format, which actually a decimal value from 0 to 1. You can achieve it using the TimeValue function.
So you'll need to Set a CopyRng object to the range you want to copy, and loop through it, each cell use the TimeValue to convert the string to a Time format.
Code
Dim CopyRng As Range
Dim i As Long
Set CopyRng = wb.ActiveSheet.Range("D2", "D32") ' <-- I would try to avoid using Active Sheet
' loop through all cells in your range
For i = 1 To CopyRng.Cells.Count
cwb.ActiveSheet.Range("B10").Offset(0, i - 1).Value = TimeValue(CopyRng.Cells(i, 1).Value)
Next i
The previous answer from Shai Rado works, but has the major throwback, that it that it has i reading + i writing operations. I also propose using the TimeValuefunction, but with only one read/write as follows:
Function transposeAsTime(SourceRng As Range, TargetRng As Range)
Dim x As Variant
Dim y As Variant
x = SourceRng
ReDim y(1 To 1, 1 To UBound(x, 1))
For i = 1 To UBound(x, 1)
y(1, i) = TimeValue(x(i, 1))
Next i
TargetRng.Resize(1, 1).Resize(1, UBound(y, 2)) = y
End Function
Execute with:
Sub test()
transposeAsTime ThisWorkbook.Sheets(1).Range("D2:D32"),
ThisWorkbook.Sheets(1).Range("D10")
End Sub
You may try to add the code below (not tested):
cwb.ActiveSheet.Range("B10").PasteSpecial Paste:=xlPasteFormats, Transpose:=True
I want to make J3:N3 = T2:X2, then I want to copy the cells formulas of T2:X2 and paste, jump one and paste and so on. The code runs fine, but does not apply my formulas in any of the cells. Any idea what I am doing wrong?
WsScenarios.Activate
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[1]C[-10]"
Range("T2").Select
Selection.AutoFill Destination:=Range("T2:X2"), Type:=xlFillDefault
Set RgnCopy = Range("T2:X2")
i = 4
Do While i <= LastRow
RgnCopy.Copy
Range(Cells(i, 20), Cells(i, 24)).PasteSpecial xlPasteFormulas
i = i + 2
Loop
Recording a macro using the Excel UI could be useful sometimes, but what matters more is to write the code in a way to get done what you want in a better way. Also you have to think about maintaning or developing the code more in future so I suggest to remove every element that is an indication of using the UI such as activating sheets, or getting inputs from the user through activecell, Select method etc.
As mentioned in one of the previous comments using Range("T2").FormulaR1C1 = "=R[1]C[-10]" would solve your problem, but if you consider two ranges as the origin and destination, then you can always do the job a lot faster and better with the least hassle to parametrise the code in a later time:
Sub CopyIt()
Dim rngOrigin As Range
Dim rngDestination As Range
Dim WS As Worksheet
Set WS = ActiveSheet
Set rngOrigin = WS.Range("T2:X2")
Set rngDestination = WS.Range("J3:N3")
rngDestination.NumberFormat = "General"
rngOrigin.Copy
rngDestination.PasteSpecial xlPasteFormulas
End Sub
I'm reaching out because on a works system computer I get run-time errors on basic macros (Excel 2010) Windows Operating System. These errors don't occur on my home Excel 2010, or 2016 systems. I should NOT be getting subscript out of range errors when performing the code in new files.
I wrote these on my own computer without any problems.
Option Explicit
Sub MoveDataOtherSheets()
With Excel.ThisWorkbook.Sheets("Sheet3")
Dim cell
For Each cell In .Range(.Cells(2, 1), Cells(.Rows.Count, 1).End(Excel.xlUp))
If cell(1, 1) = "PERSONAL" Then
With Excel.ThisWorkbook.Sheets("Sheet4")
cell.EntireRow.Copy .Cells(.Rows.Count, 1).End(Excel.xlUp)(2, 1)
End With
End If
If cell(1, 1) = "COMPANY" Then
With Excel.ThisWorkbook.Sheets("Sheet5")
cell.EntireRow.Copy .Cells(.Rows.Count, 1).End(Excel.xlUp)(2, 1)
End With
End If
Next
End With
End Sub
As I commented I think the only possible causes of that error are:
any of the worksheet names you are using is not valid for the actual workbook the running macro resides in (which is ThisWorkbook exactly)
the missing dot in the 2nd occurrence of Cells in For Each cell In .Range(.Cells(2, 1), Cells(.Rows.Count, 1).End(Excel.xlUp)) statements
thus while all other references (.Range and .Cells) are parented to the object after the last With keyword, the simple Cells(.Rows.Count, 1) actually refers to the currently active worksheet column 1 last row
but I mostly wrote this answer to propose you some refactoring of your code:
Option Explicit
Sub MoveDataOtherSheets()
Dim cell As Range, dataRng As Range
Dim shtName As String
With Excel.ThisWorkbook
Set dataRng = SetDataRng(.Worksheets("Sheet3"), 1)
For Each cell In dataRng
shtName = GetSheetName(cell)
If shtName <> "" Then CopyRow cell, .Sheets(shtName)
Next cell
End With
End Sub
Sub CopyRow(cell As Range, sht As Worksheet)
With sht
cell.EntireRow.Copy .Cells(.Rows.Count, 1).End(Excel.xlUp)(2, 1)
End With
End Sub
Function SetDataRng(sht As Worksheet, colIndex As Long) As Range
With sht
Set SetDataRng = .Range(.Cells(2, colIndex), .Cells(.Rows.Count, colIndex).End(Excel.xlUp))
End With
End Function
Function GetSheetName(cell As Range) As String
Select Case cell
Case "PERSONAL"
GetSheetName = "Sheet4"
Case "COMPANY"
GetSheetName = "Sheet5"
Case Else
GetSheetName = ""
End Select
End Function
which takes the move from the following considerations:
it's preferable not to nest With blocks referring not correlatives objects
in
With Excel.ThisWorkbook.Sheets("Sheet3")
...
With Excel.ThisWorkbook.Sheets("Sheet4")
you're nesting two not-parented With objects, thus breaking a sane With "chain" like could be the following:
With Excel.ThisWorkbook
With .Sheets("Sheet3")
...
End With
With .Sheets("Sheet4")
...
End With
End With
I'm not telling you exactly why this "chain" breaking is insane since I learned it quite a long time ago but can't recall now (!), but it has to do with memory management
avoid putting into With blocks code that doesn't use the referenced object
like that Dim cell was
those two If blocks are clearly mutually exclusive: a cell value can't equal "PERSONAL" and "COMPANY" at the same time!
so the correct If block would be:
If cell(1, 1) = "PERSONAL" Then
....
ElseIf cell(1, 1) = "COMPANY" Then
...
End If
but at this point I'd suggest you to switch to the Select Case block construct, which is more suitable for further code branching (should more comparing values arise) and more readable
it's a good coding habit to demand specific tasks to dedicated Functions/Subs
this holds true even if these tasks are up to now simple and short coded, since the code will always grow and quickly become cluttered and hardly comprehensible and maintanable
both the refactoring reasons and the refactored coded are a contribution of mine and are much likely to be improved
but they can be a good starting point
I want to copy a cell value to another cell, but I want to retain the value in a variable so I can use it as per requirement.
Following is the code i tried-
Private Sub CommandButton1_Click()
NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
For x = 1 To NumRows
a= Cells(x, 1).Value.Copy
Cells(x, 2).Value= a.PasteSpecial
Next
End Sub
No need to use the Range.Copy method. Try this:
Dim a As Variant
a = Cells(x, 1).Value
Cells(x, 2).Value = a
If you want to retain ALL of the values, you will need to use an array:
Dim x As Long
Dim NumRows As Long
NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
ReDim a(1 to NumRows)
For x = 1 To NumRows
a(x) = Cells(x,1).Value
Cells(X,2).Value = a(x)
Next x
I also recommend explicit variable declaration. It can be found in your options or by typing Option Explicitat the VERY top, above any subs or functions. This will force you to declare your variables. I know it feels like a burden as a newbee, but it only takes one typo getting declared as a new variable to change your mind.
If you just want to pass Range value to array, no need to loop.
Try something like this:
Dim a
With Sheets("YourSheetName")
a = Application.Transpose(.Range("A1", .Range("A" & _
.Rows.Count).End(xlUp).Address))
End With
'~~> check your array
For i = Lbound(a) To Ubound(a)
Debug.Print a(i)
'~~> rest of your code here to do what you like.
Next
Now, if you want to use your variable a after code execution, just declare it outside the sub like this:
Dim a As Variant '~~> you can also use Public a As Variant
Sub Something()
'~~> put similar code above here and the rest of your code
End Sub
Now, you need to put a test if the variable a is empty or not, else you'll just overwrite it and defeat your purpose.
A simple check like this should work:
If IsEmpty(a) Then '~~> or IsArray if you're sure you'll always have a as array
'~~> populate a
'~~> proceed with what you want to do with a
Else
'~~> proceed with what you want to do with a
End If
Hope it helps.
First, I suggest that you use the Record Macro facility on the Developer ribbon. Be sure to set "Use Relative References" on, and record the mouse clicks and keystrokes of one iteration of what you want to do (copy A1 to B1). Then open the macro in VB and modify it.
This is what I got when I used this approach, and it seems to work for me. I hope it works for you too.
Sub Macro1()
Dim NumRows As Integer
NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
Range("A1").Activate
For i = 1 To NumRows
ActiveCell.Select
Selection.Copy
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(1, -1).Activate
Next
End Sub
I've run accross this problem many times and still haven't found the solution or why this won't work. I want to use cells method to enter a formula through a column and so I write this:(just an example)
With ws
iEndCol = .cells(4650,1).End(Xlup).Column
For i = 2 To iEndCol
.Cells(i, 2) = "=VLOOKUP([RC-1],Somesheet!someTable,10,FALSE)"
Next
End With
when this dosen't work (Method error) I try something like this:
Cells(i,2).Select
Do While IsEmpty(ActiveCell.Offset(0, -1)) = False
ActiveCell.Formula = "=VLOOKUP([RC-1],Somesheet!someTable,10,FALSE))"
ActiveCell.Offset(1, 0).Select
Loop
or instead of .Formula, I try .FormulaR1C1, .Formulalocal etc. and this doesn't work either. Then this is what works:
Range("B2").Select
Do Until IsEmpty(ActiveCell.Offset(0, 5)) And IsEmpty(ActiveCell.Offset(0, 6))
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(0, 1).Formula = "=VLOOKUP(B2,Somesheet!someTable,10,FALSE)"
End If
ActiveCell.Offset(1, 0).Select
Loop
What am I not understanding on using Cells to enter formulas?
Enter a formula using Excel interface (not your code).
Now go to the code editor, press Ctrl+G and type: ? activecell.FormulaR1C1
The result, =VLOOKUP(RC[-1],Somesheet!sometable,10,FALSE), will tell you what you are doing wrong. You are not providing correct RC syntax.
Having that said, you should always ensure your formula syntax matches the property you have picked to set that formula. Use A1 notation for .Formula, and RC notation for FormulaR1C1. And don't use .Value to set a formula.
First, the following worked for me:
Set oCell = ActiveCell
Do
Set oCell = oCell.Offset(0, 1)
oCell.FormulaR1C1 = "=VLOOKUP(RC[-1],SomeTable,10,FALSE)"
Set oCell = oCell.Offset(1, -1)
Loop Until IsEmpty(oCell)
Notice that in my syntax, I assumed that SomeTable was a defined name with Workbook scope and thus I need no prefix. If SomeTable is a defined name scoped to a specific Worksheet, only then do you need to prefix the sheet name (e.g. Somesheet!SomeTable).
Second, you should verify in which cell it is trying to put the formula using Debug.Print oCell.Address. It may be the case that it is trying to stuff the formula in literally the first column which would cause an error in the formula.