Value calculation and result print in cells on the right

Asked

Viewed 22 times

0

I am developing a macro in VBA and I need to take each of the cells in this range and go through a select case function.

So far so good, the problem is that it makes me calculating prices and "recording" over staying in all cells of this range only the last value.

What I want is for each of the cells in the range (Column E) it will read the value and print the result in the cell on the right (Column F)

Here’s the code I got so far:

Sub Cal_PV_cal()
Dim rng As Range: Set rng = Application.Range("E1:E237")
Dim rng_out As Range: Set rng_out = Application.Range("F1:F237")

Dim Number As Range

Dim Num_out As Range


'Number = Range("E1:E237").Value    ' Initialize variable.
For Each Number In rng.Cells
    For Each Num_out In rng_out.Cells

        Select Case Number    ' Evaluate Number.
            Case 0 To 1
            Num_out = (Number * 3) * 1.23
            Case 1.001 To 3
            Num_out = (Number * 2.5) * 1.23
            Case 3.001 To 5
            Num_out = (Number * 2) * 1.23
            Case 5.001 To 10
            Num_out = (Number * 1.75) * 1.23
            Case 10.001 To 20
            Num_out = (Number * 1.5) * 1.23
            Case 20.001 To 50
            Num_out = (Number * 1.3) * 1.23
            Case 50.001 To 100000000
            Num_out = (Number * 1.25) * 1.23
            Case Else    ' Other values.
            Num_out = "ERRO"
        
        End Select
        
    Next Num_out
Next Number


End Sub

1 answer

1


The way you nestled these For Each causes your program to have this behavior. For each input cell your program all the output cells making the Select Case with the current entry, so keep the last in all exits.

To fix, control which cell of the output range will be placed the result. In my case I removed the For Each from within and used the Offset to set the destination. But I did not put the required validation that the size of the input and output range should be equal.

Sub Cal_PV_cal()
Dim rng As Range: Set rng = Application.Range("E1:E237")
Dim rng_out As Range: Set rng_out = Application.Range("F1:F237")

Dim Number As Range
Dim Num_out As Range
Dim i As Long
i = 0

For Each Number In rng.Cells
    'Pega celula correspondente no range de saida
    Set Num_out = rng_out(1, 1).Offset(i, 0)

        Select Case Number    ' Evaluate Number.
            Case 0 To 1
            Num_out = (Number * 3) * 1.23
            Case 1.001 To 3
            Num_out = (Number * 2.5) * 1.23
            Case 3.001 To 5
            Num_out = (Number * 2) * 1.23
            Case 5.001 To 10
            Num_out = (Number * 1.75) * 1.23
            Case 10.001 To 20
            Num_out = (Number * 1.5) * 1.23
            Case 20.001 To 50
            Num_out = (Number * 1.3) * 1.23
            Case 50.001 To 100000000
            Num_out = (Number * 1.25) * 1.23
            Case Else    ' Other values.
            Num_out = "ERRO"
        
        End Select
        
    'Próximo i
    i = i + 1
Next Number


End Sub

Browser other questions tagged

You are not signed in. Login or sign up in order to post.