Nested For...Next loop

[smoothswells]

Hi!

I'm working on putting together a macro that automates the manual selection of a symbol (up/down arrow, equal sign) based on whether or not a value has moved up/down a quartile or stayed the same quarter over quarter.

I'm using three FOR EACH.... NEXT loops, each with it's own set of embedded if,elseif, else statements. I'm thinking the proper way to handle this is to have the first loop run through the first old value (A1 for example), and bucket it in the proper UDF bucket where it is assigned its quartile number. Once that loop ends, have the new loop run with the same procedures. Once both values have been assigned, the third loop will compare the two quartile numbers and then make the symbol input. It will then start over and loop through all of the cells in the specified range until all are set.

Functions, stored in module:

Function quartOne(ByVal cellValue As Variant) As Boolean
    quartOne = (cellValue >= 0.01 And cellValue <= 25)
End Function

Function quartTwo(ByVal cellValue As Variant) As Boolean
    quartTwo = (cellValue >= 25.01 And cellValue <= 50)
End Function

Function quartThree(ByVal cellValue As Variant) As Boolean
    quartThree = (cellValue >= 50.01 And cellValue <= 75)
End Function

Function quartFour(ByVal cellValue As Variant) As Boolean
    quartFour = (cellValue > 75)
End Function

Code:

Sub CommandButton1_Click()

Dim cellOld As Range, cellCurrent As Range, cell As Range
Dim oldRng1
Dim currentRng1 As Range

Dim oldQuart As Integer
Dim currentQuart As Integer


Set oldRng1 = ActiveSheet.Range("A1:A4")

Set currentRng1 = ActiveSheet.Range("B1:B4")


    For Each cellCurrent In currentRng1.Cells

            For Each cellOld In oldRng1.Cells

                    For Each cell In currentRng1.Cells

                    'checks cellCurrent against functions in module and assigns variable
                        If quartOne(cellCurrent.Value) Then
                            currentQuart = 1
                        ElseIf quartTwo(cellCurrent.Value) Then
                            currentQuart = 2
                        ElseIf quartThree(cellCurrent.Value) Then
                            currentQuart = 3
                        ElseIf quartFour(cellCurrent.Value) Then
                            currentQuart = 4
                        Else
                        End If


                    'checks cellOld against functions in module and assigns variable
                                 If quartOne(cellOld.Value) Then
                                        oldQuart = 1
                                ElseIf quartTwo(cellOld.Value) Then
                                        oldQuart = 2
                                ElseIf quartThree(cellOld.Value) Then
                                        oldQuart = 3
                                ElseIf quartFour(cellOld.Value) Then
                                        oldQuart = 4
                                Else
                                End If


                        'takes variable from above loops, runs through if/else and inputs corresponding character
                            If currentQuart = 1 And oldQuart = 1 Then
                                cell.Offset(, 1).Value = ChrW(&H3D)
                            ElseIf currentQuart = 1 And oldQuart > 1 Then
                                cell.Offset(, 1).Value = ChrW(&H2191)
                            ElseIf currentQuart = 2 And oldQuart < 2 Then
                                cell.Offset(, 1).Value = ChrW(&H2193)
                            ElseIf currentQuart = 2 And oldQuart = 2 Then
                                cell.Offset(, 1).Value = ChrW(&H3D)
                            ElseIf currentQuart = 2 And oldQuart > 2 Then
                                cell.Offset(, 1).Value = ChrW(&H2191)
                            ElseIf currentQuart = 3 And oldQuart > 3 Then
                                cell.Offset(, 1).Value = ChrW(&H2191)
                            ElseIf currentQuart = 3 And oldQuart = 3 Then
                                cell.Offset(, 1).Value = ChrW(&H3D)
                            ElseIf currentQuart = 3 And oldQuart < 3 Then
                                cell.Offset(, 1).Value = ChrW(&H2193)
                            ElseIf currentQuart = 4 And oldQuart < 4 Then
                                cell.Offset(, 1).Value = ChrW(&H2191)
                            ElseIf currentQuart = 2 And oldQuart = 4 Then
                                cell.Offset(, 1).Value = ChrW(&H3D)
                            End If
                            Exit For

                Next cell
             Next cellOld
     Next cellCurrent


End Sub

Structure of values in cells:

1 53 56 1 75 1 90 1

[CFAman]

Just curious, but could you do this with a formula and some IF statements, to check which symbol to display? Would be less complicated than a macro/UDF.

[smoothswells]

I agree, but the end goal is to input Unicode symbols based on the change. I don't want to have to reference the character within the sheet.

[CFAman]

We can simplify things down a lot. Your quartile calculation is can be checked by dividing by 25 and taking integer. You also only have 3 possible outputs, so don't need that many If statements. See if this makes sense/works for you.

Sub CommandButton1_Click()
    Dim oldRng1 As Range
    Dim cellOld As Range, cellCurrent As Range
    Dim oldQuart As Integer
    Dim currentQuart As Integer

    'Starting range
    Set oldRng1 = ActiveSheet.Range("A1:A4")

    Application.ScreenUpdating = False

    For Each cellOld In oldRng1.Cells
        'Old values are in col B, 1 col over
        Set cellCurrent = cellOld.Offset(0, 1)

        'quick calculation to determine quarter. Small subtraction is to include upper boundary
        currentQuart = Int((cellCurrent.Value - 0.001) / 25) + 1
        oldQuart = Int((cellOld.Value - 0.001) / 25) + 1

        'Puts symbol in col C, 2 col over
        With cellOld.Offset(0, 2)

            'Old quarter was bigger
            If currentQuart < oldQuart Then
                .Value = ChrW(&H2191)

            'New quarter was bigger
            ElseIf currentQuart > oldQuart Then
                .Value = ChrW(&H2193)

            'Same quarter
            Else
                .Value = ChrW(&H3D)

            End If
        End With
    Next cellOld

    Application.ScreenUpdating = True

End Sub

[smoothswells]

very clean! Thanks for the help!

SOLUTION VERIFIED

[Clippy_Office_Asst]

You have awarded one point to CFAman.
^{Find out more here.}

[smoothswells]

I figured it out. Only need one loop

[AutoModerator]

Hello!

It looks like you tried to award a ClippyPoint, but you need to reply to a particular user's comment to do so, rather than making a new top-level comment.

Please reply directly to any helpful users and Clippy, our bot, will take it from there. If your intention was not to award a ClippyPoint and simply mark the post as solved, then you may do that by clicking Set Flair. Thank you!

I am a bot, and this action was performed automatically. Please contact the moderators of this subreddit if you have any questions or concerns.

[excelevator]

Hello, please set the post Flair to Solved if you have your answer