JackeyOL
JackeyOL

Reputation: 321

Adding 1 to each row without using for loop in VBA

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:

enter image description here

to this:

enter image description here

Upvotes: 2

Views: 1085

Answers (5)

Amiga500
Amiga500

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

norie
norie

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

VBasic2008
VBasic2008

Reputation: 54807

Increase Range Values

  • In the following examples, the Add solution took 2.4s while the Array solution took 8.7s (on my machine) to process 5 columns.
  • In the Array solution, the selection is never changed, it just writes the result to the range.
  • The 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

chris neilsen
chris neilsen

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

teylyn
teylyn

Reputation: 35915

Start the macro recorder.

  • type a 1 into an empty cell
  • copy that cell
  • select the cells that you want to add that value to
  • open the Paste Special dialog
  • select "Add" and OK

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

Related Questions