Even and Odd

Intermediate Exercise

Statement

Create an InputBox that will insert all inputted values into column "A" of the current worksheet (one line for each input). Make it so that it only allows the input of integer numbers (does not allow the input of non-integers or of non-numeric values). Additionally, create a Sub to transfer all even values above 42 into line 1 of the "SVBA_Export" worksheet, organizing them in ascending order. This subroutine should also calculate the square of all odd numbers inputted and organize the results in line 3 of the "SVBA_Export" worksheet in descending order. The InputBox should stop collecting data if the input is left in blank and the "OK" button is pressed.

Suggested Concepts:

Dim
End .Row
If Else
Msgbox
Do Loop
For Next
Set
Offset
CurrentRegion
InputBox
IsNumeric - Function that returns True if the value is numeric
CInt
CDbl
With

Remember that in most cases there is more than one way to solve the exercise.

Hint: Create a loop within another. If the variable of the second loop have a higher value than the variable of the first, substitute the variable

Solved Exercise

Exercise Solution

Step 1 - We will start with the subroutine that will plot the data into the worksheet

We declare the variables
```
Dim ValC As Variant
Dim i As Integer
```
We assign the value 2 to the variable i and we create a Do...Loop Until
```
i = 2
Do
```

Within the Do Loop, we create an InputBox and we assign to the variable ValC the value inputted by the user

ValC = InputBox("Please enter a number" & vbCrLf & vbCrLf & "Click Ok or Cancel with the entry empty when you are finished.", "SuperExcelVBA")

Then, we create two If Else conditionals. The first will send an alert MsgBox to the user if a non-numeric value is inserted. The second will end the Do Loop if a blank input is inserted
```
If Not IsNumeric(ValC) Then
    If ValC = vbNullString Then
        Exit Do
    End If
    MsgBox "Enter numeric content", vbCritical, "SuperExcelVBA"
```

Now we create a conditional that will send an alert MsgBox to the user if a numeric non-integer is inputted

Else
    If CInt(ValC) <> CDbl(ValC) Then
    MsgBox "Enter only integers", vbCritical, "SuperExcelVBA"

Finally, if an integer is inserted, then its value will be assigned to ValC and it will be plotted into the worksheet
```
Else
i = i + 1
Cells(i, 1) = ValC
```

For aesthetics, we configure the border pattern of the plotted cell

        With Cells(i, 1)
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeLeft).Weight = xlHairline
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlEdgeRight).Weight = xlHairline
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).Weight = xlHairline
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeTop).Weight = xlHairline
        End With
        End If
    End If
Loop Until ValC = vbNullString

Step 2 - In this step we create the subroutine that will export values to the "SVBA_Export" worksheet according to the exercise's criteria

We declare the variables

Dim j As Integer
Dim LastRow As Long
Dim ValC As Double
Dim temp As Long
Dim p As Integer
Dim i As Long
Dim Rng As Range

We assign the last data of the lines of the "SVBA_Solution" worksheet (or "SVBA_Exercise", if it's in the exercise workbook) to the variable LastRow.
```
LastRow = Sheets("SVBA_Solution").Cells(Rows.Count, 1).End(xlUp).Row
```
We create a For Next loop that will run from the third to the last line of the worksheet
```
For j = 3 To LastRow
```
We assign the loop's iteration value to the variable ValC and we create an If conditional to verify if the cell's inputted value is even or odd
```
ValC = Sheets("SVBA_Gabarito").Cells(j, 1).Value
If ValC Mod 2 = 1 Then 'Odd
```
Then we export the squares of ValC odd numbers to the "SVBA_Export" worksheet Note that we use the Offset property to avoid blank cells in the transferred list
```
Sheets("SVBA_Export").Cells(3, 2).Offset(, p).Value = (ValC) ^ 2
```

We configure the layout of the output cells

With Sheets("SVBA_Export").Cells(3, 2).Offset(, p)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Weight = xlHairline
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeRight).Weight = xlHairline
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).Weight = xlHairline
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeTop).Weight = xlHairline
End With

We increase the p value of each new entry by 1 to keep the transferred sequence without blank cells
```
p = p + 1
```

Now we repeat the same process to even numbers following their own criteria

        Else 'Even
        If ValC > 42 Then 
            Sheets("SVBA_Export").Cells(1, 2).Offset(, i).Value = ValC
            With Sheets("SVBA_Export").Cells(1, 2).Offset(, i)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeLeft).Weight = xlHairline
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlEdgeRight).Weight = xlHairline
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).Weight = xlHairline
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeTop).Weight = xlHairline
            End With
            i = i + 1
        End If
    End If
Next j

Now that all the data is transferred, we need to order the numbers. Squares of odd numbers will be ordered in descending order and even numbers above 42 in ascending order. We establish the CurrentRegion for the even numbers
```
Set Rng = Sheets("SVBA_Export").Cells(1, 2).CurrentRegion
```

We create a For Next loop to organize the data in ascending order

For i = 2 To Rng.Count
    For j = i + 1 To Rng.Count
    If Rng.Cells(j) < Rng.Cells(i) Then
        temp = Rng.Cells(i)
        Rng.Cells(i) = Rng.Cells(j)
        Rng.Cells(j) = temp
    End If
    Next j
Next i

We establish the CurrentRegion for the squares of odd numbers

Set Rng = Sheets("SVBA_Export").Cells(3, 2).CurrentRegion

And we create a For Next loop to organize those numbers

For i = 2 To Rng.Count
    For j = i + 1 To Rng.Count
    If Rng.Cells(j) > Rng.Cells(i) Then
        temp = Rng.Cells(i)
        Rng.Cells(i) = Rng.Cells(j)
        Rng.Cells(j) = temp
    End If
    Next j
Next i

Consolidated Answer

Sub Plot_Values()

    Dim ValC As Variant
    Dim i As Integer

    i = 2
    Do
        ValC = InputBox("Please enter a number" & vbCrLf & vbCrLf & "Click Ok or Cancel with the entry empty when you are finished.", "SuperExcelVBA")
        If Not IsNumeric(ValC) Then
            If ValC = vbNullString Then
                Exit Do
            End If
            MsgBox "Enter numeric content", vbCritical, "SuperExcelVBA"
        Else
            If CInt(ValC) <> CDbl(ValC) Then
            MsgBox "Insira apenas números inteiros", vbCritical, "SuperExcelVBA"
            Else
            i = i + 1
            Cells(i, 1) = ValC
            With Cells(i, 1)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeLeft).Weight = xlHairline
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlEdgeRight).Weight = xlHairline
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).Weight = xlHairline
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeTop).Weight = xlHairline
            End With
            End If
        End If
    Loop Until ValC = vbNullString

End Sub

Sub Export()

    Dim j As Integer
    Dim LastRow As Long
    Dim ValC As Double
    Dim temp As Long
    Dim p As Integer
    Dim i As Long
    Dim Rng As Range

    LastRow = Sheets("SVBA_Solution").Cells(Rows.Count, 1).End(xlUp).Row

    For j = 3 To LastRow 'Odd
        ValC = Sheets("SVBA_Solution").Cells(j, 1).Value
        If ValC Mod 2 = 1 Then
            Sheets("SVBA_Export").Cells(3, 2).Offset(, p).Value = (ValC) ^ 2
            With Sheets("SVBA_Export").Cells(3, 2).Offset(, p)
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlHairline
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlHairline
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlHairline
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlHairline
            End With
            p = p + 1
            Else
            If ValC > 42 Then 'Even
                Sheets("SVBA_Export").Cells(1, 2).Offset(, i).Value = ValC
                With Sheets("SVBA_Export").Cells(1, 2).Offset(, i)
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlHairline
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlHairline
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlHairline
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlHairline
                End With
                i = i + 1
            End If
        End If
    Next j

    Set Rng = Sheets("SVBA_Export").Cells(1, 2).CurrentRegion

        For i = 2 To Rng.Count
            For j = i + 1 To Rng.Count
            If Rng.Cells(j) < Rng.Cells(i) Then
                temp = Rng.Cells(i)
                Rng.Cells(i) = Rng.Cells(j)
                Rng.Cells(j) = temp
            End If
            Next j
        Next i

    Set Rng = Sheets("SVBA_Export").Cells(3, 2).CurrentRegion

        For i = 2 To Rng.Count
            For j = i + 1 To Rng.Count
            If Rng.Cells(j) > Rng.Cells(i) Then
                temp = Rng.Cells(i)
                Rng.Cells(i) = Rng.Cells(j)
                Rng.Cells(j) = temp
            End If
            Next j
        Next i

End Sub

Show Answer

Download exercise Download answer

SuperExcelVBA.com is learning website. Examples might be simplified to improve reading and basic understanding. Tutorials, references, and examples are constantly reviewed to avoid errors, but we cannot warrant full correctness of all content. All Rights Reserved.

Excel ® is a registered trademark of the Microsoft Corporation.

INTRODUCTION

BASIC

INTERMEDIATE

ADVANCED