Ben
Ben

Reputation: 11

Subtract Single Cell Value from Column Until Empty Cell

I'm looking to 'normalize' a column of data by setting the minimum value to 0 and shifting the entire column's data by the difference of the min value and 0.

The code should be simple, but I can't find the appropriate range selection to stop the code when it reaches a blank cell.

Below is the core that I've unsuccessfully been working off of trying to recognize the first empty cell in column U after U9 up to U700 and correspondingly stop subtracting in column Z. Example screenshots are attached. Thank you!

Private Sub CommandButton1_Click()

[Z9:Z700] = [U9:U700-U8]

End Sub

This is what I get:

This is what I get

This is what I would like to get:

This is what I would like to get

Upvotes: 1

Views: 366

Answers (1)

Olly
Olly

Reputation: 7891

Try this:

Sub foo()
    Dim lRow As Long
    With ActiveSheet
        lRow = .Cells(Rows.Count, "U").End(xlUp).Row
        .Range("U9:U" & lRow).Copy .Range("Z9")
        With .Range("U8")
            .Formula = "=MIN(U9:U" & lRow & ")"
            .Copy
        End With
        .Range("Z9:Z" & lRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlSubtract
        Application.CutCopyMode = False
    End With
End Sub

EDIT:

If you have formulas in Column U, below your list of numbers, which are returning blank values, then this revision might work better for you:

Sub foo2()
    Dim lRows As Long
    With ActiveSheet
        lRows = WorksheetFunction.Count(.Range("U9:U700"))
        .Range("U8").Formula = "=MIN(" & .Range("U9").Resize(lRows, 1).Address(0, 0) & ")"
        .Range("U9").Resize(lRows, 1).Copy
        .Range("Z9").PasteSpecial Paste:=xlPasteValues
        .Range("U8").Copy
        .Range("Z9").Resize(lRows, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlSubtract
    End With
    Application.CutCopyMode = False
End Sub

Upvotes: 1

Related Questions