Reputation: 321
Looking for an easy way to add a certain number to each row in a column. Something like range("b1:b9")=range("a1:a9")+1
From this:
to this:
Upvotes: 2
Views: 1085
Reputation: 1275
#1. Disable your autocalculations
Application.Calculation = xlCalculationManual
#2. Disable your screenupdating
Application.ScreenUpdating = False
#3. As long as your row entries aren't more than ~56000, but your dataset is substantial then its quicker to read into an array, do the manipulations in an array, then output that array in one go.
array1 = Range(cells(3,2), cells(12,2)).value
for i = 1 to ubound(array1, 1)
array1(i, 1) = array(i, 1) + 1
next i
range(cells(3,10), cells(12,10)) = array1
Note that array1 will be 2D, and you'll be addressing (1,1) through to (10,1) in the example above
Then after pasting back in, reenable your autocalcs, THEN your screenupdate
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Upvotes: 0
Reputation: 9857
You could use Evaluate, seems quite quick.
Sub Add1()
With Range("A1:A10000")
.Value = Evaluate(.Address & "+1")
End With
End Sub
Upvotes: 2
Reputation: 54807
Add
solution took 2.4s while the Array
solution took 8.7s (on my machine) to process 5 columns.Array
solution, the selection is never changed, it just writes the result to the range.Add
solution is kind of mimicking this behavior, by setting all selections as they initially were. Hence the complications.Option Explicit
' Add Solution
Sub increaseRangeValuesTEST()
increaseRangeValues Sheet1.Range("A:E"), 1 ' 2.4s
End Sub
Sub increaseRangeValues( _
ByVal rg As Range, _
ByVal Addend As Double)
Application.ScreenUpdating = False
Dim isNotAW As Boolean: isNotAW = Not rg.Worksheet.Parent Is ActiveWorkbook
Dim iwb As Workbook
If isNotAW Then Set iwb = ActiveWorkbook: rg.Worksheet.Parent.Activate
Dim isNotAS As Boolean: isNotAS = Not rg.Worksheet Is ActiveSheet
Dim iws As Worksheet
If isNotAS Then Set iws = ActiveSheet: rg.Worksheet.Activate
Dim cSel As Variant: Set cSel = Selection
Dim aCell As Range: Set aCell = ActiveCell
Dim sCell As Range: Set sCell = rg.Cells(rg.Rows.Count, rg.Columns.Count)
Dim sValue As Double: sValue = sCell.Value + Addend
sCell.Value = Addend
sCell.Copy
rg.PasteSpecial xlPasteAll, xlPasteSpecialOperationAdd ' 95%
Application.CutCopyMode = False
sCell.Value = sValue
aCell.Activate
cSel.Select
If isNotAS Then iws.Activate
If isNotAW Then iwb.Activate
Application.ScreenUpdating = True
End Sub
' Array Solution
Sub increaseRangeValuesArrayTEST()
increaseRangeValuesArray Sheet1.Range("A:E"), 1 ' 8.7s
End Sub
Sub increaseRangeValuesArray( _
ByVal rg As Range, _
ByVal Addend As Double)
With rg
Dim rCount As Long: rCount = .Rows.Count
Dim cCount As Long: cCount = .Columns.Count
Dim Data As Variant
If rCount > 1 Or cCount > 1 Then
Data = .Value
Else
ReDim Data(1 To 1, 1 To 1): Data = .Value
End If
Dim r As Long, c As Long
For r = 1 To rCount
For c = 1 To cCount
Data(r, c) = Data(r, c) + Addend
Next c
Next r
.Value = Data ' 80%
End With
End Sub
Upvotes: 0
Reputation: 53126
Looking for a "time-efficient" solution and avoiding loops are not the same thing.
If you were to loop over the range itself, then yes, it would be slow. Copying the range data to a Variant array, looping that, then copying the result back to the range is fast.
Here is a demo
Sub Demo()
Dim rng As Range
Dim dat As Variant
Dim i As Long
Dim t1 As Single
t1 = Timer() ' just for reportingh the run time
' Get a reference to your range by whatever means you choose.
' Here I'm specifying 1,000,000 rows as a demo
Set rng = Range("A1:A1000000")
dat = rng.Value2
For i = 1 To UBound(dat, 1)
dat(i, 1) = dat(i, 1) + 1
Next
rng.Value2 = dat
Debug.Print "Added 1 to " & UBound(dat, 1) & " rows in " & Timer() - t1; " seconds"
End Sub
On my hardware, this runs in about 1.3 seconds
FYI, the PasteSpecial, Add technique is faster still
Upvotes: 1
Reputation: 35915
Start the macro recorder.
Stop the macro recorder. Use that code as is or work it into your other code.
Range("C1").Value = 1
Range("C1").Select
Application.CutCopyMode = False
Selection.Copy
Range("A1:A5").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= False, Transpose:=False
Upvotes: 0