VBA Add Adjacent cells

Question

We have a spreadsheet at our company to track hours. It has a column for hours spent on a given project per week and total hours for the project. Each project has a row. Every Monday I manually add the number of hours from last week to the total hours column. I'd like to automate this. I am attempting to loop through column J and, if there is a number in J, add it to K. Then clear cell J (I haven't added this part into the below code, yet). J can be blank, or have non-numeric values, these should be skipped. J will never go past J500.

This is my code, it appears to just loop the currently selected row 500 times in "Megan in Progress" rather than moving from J1 through J500. Could someone help point me towards what I'm doing wrong? Thank you.

Sub UpdateTotals()
Sheets("Megan In Progress").Activate
For Each cell In Sheets("Megan In Progress").Range("J1:J500")
    Dim weekVal As Double
    If IsNumeric(cell) = True Then
        weekVal = cell.Value
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = ActiveCell.Value + weekVal
        ActiveCell.Offset(0, -1).Select
    End If
Next
End Sub

before macro

after macro

`ActiveCell/.Select` 0_0??? [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) Use objects and then try again. When using `ActiveCell.Value` after `ActiveCell.Offset(0, 1).Select`, the active cell is not the cell you think is active. ;) — Siddharth Rout, Aug 20 '18 at 19:05

GMalc · Answer 1 · 2018-08-20T20:00:56.580

2

Try this:

For Each cell In Range("K2:K500")
    'Adds the adjacent cell in column J to the current cell value
    cell.Value = cell + cell.Offset(, -1)
    'Clears the weekly values form column J
    cell.Offset(, -1).Clear
    'Clear 0s in column K
    If cell.Value = 0 Then cell.Clear
Next

edited Aug 20 '18 at 20:00

answered Aug 20 '18 at 19:19

GMalc

2,608
1
9
16

score 2 · Accepted Answer · answered Aug 20 '18 at 19:22

There are a few things I would do differently to get this working. Firstly, I would avoid using "cell" as your variable name, since that's an Excel function name. It works as is, but it's awkward. How about rngCell (since it's a range object)?

The weekVal variable is not needed, and really shouldn't be dimensioned inside the loop anyway. But you should dimension the loop variable you're using.

The IsNumeric function takes a text parameter, so you should include the .Text property of your loop variable in the function.

Next, since you're looping all the cells in your range, there's no need to select anything, and this will only slow down the execution. Just act relative to your loop variable.

Here's how I would re-write the function:

Sub UpdateTotals()

   Dim rngCell as range

   Sheets("Megan In Progress").Activate
   For Each rngCell In Sheets("Megan In Progress").Range("J1:J500")
     If IsNumeric(rngCell.Text) Then
        rngCell.Offset(0, 1) = rngCell.offset(0, 1).value + rngCell.Value
        rngCell = ""
     End If
   Next
End Sub

++ nicely explained... BTW you can get rid of `Sheets("Megan In Progress").Activate` ;) — Siddharth Rout, Aug 20 '18 at 19:23
Like I said, it works with "cell" as the variable name, but I believe a bit of attention to coding style makes the world a better place. Cell is a worksheet function. — Steve Bull, Aug 20 '18 at 19:29

Cyril · Answer 3 · 2018-08-20T21:17:06.830

I am unsure if you want the J column value removed regardless, which occurs below:

Dim i As Long, j As Double, k As Double
With Sheets("Megan In Progress")
    For i = 1 To 500
        If IsNumeric(.Cells(i, "K").Value) = True Then k = .Cells(i, "K").Value
        j = .Cells(i, "J").Value
        .Cells(i, "K").Value = j + k
        .Cells(i, "J").Value = ""
        j = 0
        k = 0
    Next i
End With

This uses a for loop, rather than a for each loop.

score 0 · Answer 4 · answered Aug 21 '18 at 02:17

Try this.

Sub UpdateTotals()
    Dim Ws As Worksheet
    Dim vDB As Variant, rngDB As Range
    Dim i As Long, n As Long

    Set Ws = Sheets("Megan In Progress")
    Set rngDB = Ws.Range("j1:k500")
    vDB = rngDB
    n = UBound(vDB, 1)
    For i = 1 To n
        If IsNumeric(vDB(i, 1)) Then
            vDB(i, 2) = vDB(i, 1) + vDB(i, 2)
            vDB(i, 1) = Empty '<~~ clear numeric cells
        End If
        'vDB(i, 1) = Empty '<~~ clear all cells
    Next i
    rngDB = vDB
End Sub

VBA Add Adjacent cells

4 Answers4