Go through Cells and Round to Closest 5 VBA

Question

I have a spreadsheet with 50K values on it.

I want it a code to go through every value and check to see if it ends in a 5 or 0 and if it doesn't not to round to the nearest of the two.

I tried this as my code

Sub Round_flow()

Dim nxtRow As Long, found As Boolean, i As Long, minus As Long, plus As Long, equal As Long, cell As Boolean, f As Integer
    nxtRow = 2
    found = False
    i = Sheet1.Cells(nxtRow, 2)
    minus = -2
    equal = 0 

While Not found 'finds last used row
    If (Cells(nxtRow, 2) = "") Then
        found = True
    Else
        nxtRow = nxtRow + 1
    End If
Wend

For f = 2 To i 
For minus = -2 To 168 Step 5 
    If ActiveCell.Value <> equal Then
        While Not cell
             plus = minus + 4
            equal = minus + 2
            If minus <= ActiveCell.Value <= plus Then
                Sheet1.Cells(i, 2).Value = equal
                cell = True
            End If
        Wend
    End If
    Next minus
Next f 

Essentially what I was trying to do is say here is the last row, i want to check every value from i to last filled row to see if it falls between any plus and minus value (+-2 of the nearest 5 or 0) then have whatever activecell.value be replaced by the 0 or 5 ending digit 'equal' which changes with each iteration.

Answer 1

Ok, that seems way too complicated. To round to 5, you just multiply by 2, round, then divide by 2. Something like this will do the trick:

Dim NumberToBeRounded as Integer
Round(NumberToBeRounded *2/10,0)/2*10

*2 and /2 to get it to be rounded to 5, and /10 *10 to make the round function round for less than 0 decimals.

(I have to admit, I don't really understand what your code is trying to do, I hope I didn't completely misunderstand your needs.)

This should do the trick:

Sub Round_flow()
 For f = 2 To Cells(1, 2).End(xlDown).Row
  Cells(f, 2).Value = Round(Cells(f, 2).Value * 2 / 10) / 2 * 10
 Next
End Sub

Cells(1, 2).End(xlDown).Row finds the last used cell, unless you have no data; if that can happen, add some code to check if you have at least 2 rows. Or you can use the Usedrange and SpecialCells(xlLastCell) combo to find the last used row of your table...

Answer 2

Another way:

Sub RoundEm()
  Dim wks           As Worksheet
  Dim r             As Range
  Dim cell          As Range

  Set wks = ActiveSheet  ' or any other sheet
  On Error Resume Next
  Set r = wks.Cells.SpecialCells(xlCellTypeConstants, xlNumbers)
  On Error GoTo 0

  If Not r Is Nothing Then
    For Each cell In r
      cell.Value2 = Round(cell.Value2 / 5, 0) * 5
    Next cell
  End If
End Sub