Nested selection for multiple conditions

Situation: I have a code that goes through some data on a sheet and sets what is in a certain cell, it inserts something into another column (the same row).

Example: If my A5 is a β€œLink”, it combines the contents of A5 and B5 and inserts it into J5.

Obs1: There are dozens of sub-conditions for the first, second, third, and fourth data columns.

What I have tried so far: I was able to create a very long Nested If chain and take into account all the conditions. I was also able to use the selection case to account for the conditions of the first column.

Problem: Now I'm trying to use the nested Select Case to account for these conditions (given that the If chain is gigantic and too long to be effective). The problem is that I cannot correctly account for nested Select Cases for multiple conditions.

Question: What is the best way to work with a nested Select Case if there are several conditions?

Obs2: From a previous study, I found here messages about nested ifs, especially when there is a true or false value. This does not work for me, because each layer has many more conditions.

Code1: This is what I got so far with Select Case:

Function fxr2()

Dim lRow As Long, LastRow As Long
Dim w As Workbook
Dim ws As Worksheet

Set w = ThisWorkbook

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

LastRow = Worksheets("Fixer").Cells(Rows.Count, "A").End(xlUp).Row

For lRow = 7 To LastRow

Dim type1 As String, result As String
type1 = w.Worksheets("Fixer").Cells(lRow, 1).Text

Select Case type1
Case Is = "Bail-in"
    result = w.Worksheets("Fixer").Cells(lRow, 1)
Case Is = "Basel"
    result = w.Worksheets("Fixer").Cells(lRow, 1) & " " & w.Worksheets("Fixer").Cells(lRow, 2) & " " & w.Worksheets("Fixer").Cells(lRow, 3) & " " & w.Worksheets("Fixer").Cells(lRow, 4) & " " & w.Worksheets("Fixer").Cells(lRow, 5)
Case Is = "Collateral"
    result = w.Worksheets("Fixer").Cells(lRow, 1) & " " & w.Worksheets("Fixer").Cells(lRow, 2) & " " & w.Worksheets("Fixer").Cells(lRow, 3)
Case Is = "Design"
    result = w.Worksheets("Fixer").Cells(lRow, 1)
Case Is = "General"
    result = w.Worksheets("Fixer").Cells(lRow, 1) & " " & w.Worksheets("Fixer").Cells(lRow, 2) & " " & w.Worksheets("Fixer").Cells(lRow, 3)
Case Is = "Investment"
    result = w.Worksheets("Fixer").Cells(lRow, 1)
Case Is = "Lower"
    result = w.Worksheets("Fixer").Cells(lRow, 1) & " " & w.Worksheets("Fixer").Cells(lRow, 2) & " " & w.Worksheets("Fixer").Cells(lRow, 3)
Case Is = "Recapitalization"
    result = w.Worksheets("Fixer").Cells(lRow, 1)
Case Is = "Refinance"
    result = w.Worksheets("Fixer").Cells(lRow, 1)
Case Is = "Upper"
    result = w.Worksheets("Fixer").Cells(lRow, 1) & " " & w.Worksheets("Fixer").Cells(lRow, 2) & " " & w.Worksheets("Fixer").Cells(lRow, 3)
Case Else
    result = w.Worksheets("Fixer").Cells(lRow, 1) & " " & 
w.Worksheets("Fixer").Cells(lRow, 2)
End Select

w.Worksheets("Fixer").Cells(lRow, 10).Value = result

Next lRow

End Function

Code 2: And this is a small part of the code in which I used nested Ifs:

ElseIf w.Worksheets("Fixer").Cells(lRow, 1) = "General" Then
    w.Worksheets("Fixer").Cells(lRow, 10) = 
w.Worksheets("Fixer").Cells(lRow, 1) & " " & 
w.Worksheets("Fixer").Cells(lRow, 2) & " " & w.Worksheets("Fixer").Cells(lRow, 3)

    If w.Worksheets("Fixer").Cells(lRow, 4) = "Base" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Inte" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Tier" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "v" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Ba" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Bas" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Int" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Inte" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Inter" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Tie" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Tier-" Then
        w.Worksheets("Fixer").Cells(lRow, 11) = ""

    ElseIf w.Worksheets("Fixer").Cells(lRow, 4) = "" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Upp" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Uppe" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Upper" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "I" Or w.Worksheets("Fixer").Cells(lRow, 4) = "L" Or w.Worksheets("Fixer").Cells(lRow, 4) = "T" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "U" Then
        w.Worksheets("Fixer").Cells(lRow, 11) = ""

    ElseIf w.Worksheets("Fixer").Cells(lRow, 4) = "Design" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Inve" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Inv" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Low" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Lowe" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Proj" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Pro" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Ref" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Refi" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Stock" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Inve" Then
        w.Worksheets("Fixer").Cells(lRow, 11) = 
w.Worksheets("Fixer").Cells(lRow, 4)

    ElseIf w.Worksheets("Fixer").Cells(lRow, 4) = "LBO" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Working" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Work" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Wor" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Gre" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Gree" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Green" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Interc" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Intercom" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Intercompany" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Intermed" Then
        w.Worksheets("Fixer").Cells(lRow, 11) = 
w.Worksheets("Fixer").Cells(lRow, 4)

    ElseIf w.Worksheets("Fixer").Cells(lRow, 4) = "Low" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Lower" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "Lowe" Or 
w.Worksheets("Fixer").Cells(lRow, 4) = "No" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Pen" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Pens" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Pension" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Projec" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Project" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Refin" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Refina" Then
        w.Worksheets("Fixer").Cells(lRow, 11) = w.Worksheets("Fixer").Cells(lRow, 4)

    ElseIf w.Worksheets("Fixer").Cells(lRow, 4) = "Refinanc" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Refinance" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Stoc" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Sto" Or w.Worksheets("Fixer").Cells(lRow, 4) = "w" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Wor" Or w.Worksheets("Fixer").Cells(lRow, 4) = "W" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Tier-1" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Tier-2" Then
        w.Worksheets("Fixer").Cells(lRow, 11) = w.Worksheets("Fixer").Cells(lRow, 4)

    End If

Obs3: , , . Sample data

+4
3

1 ( 1) ( ):

Function fxr2()

Dim lRow As Long, LastRow As Long
Dim w As Workbook
Dim ws As Worksheet

Set w = ThisWorkbook
Set ws = w.Worksheets("Fixer") '<-- set the worksheet

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim type1 As String, result As String '<-- There no need to Dim them every time inside the loop

' use With statement, will simplify and shorten your code later
With ws
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row '<-- fully qualify Rows.Count with "Fixer" sheet

    For lRow = 7 To LastRow
        type1 = .Cells(lRow, 1).Text

        Select Case type1
            Case "Bail-in", "Investment", "Recapitalization", "Refinance", "Design"
                result = .Cells(lRow, 1)

            Case "Basel"
                result = .Cells(lRow, 1) & " " & .Cells(lRow, 2) & " " & .Cells(lRow, 3) & " " & .Cells(lRow, 4) & " " & .Cells(lRow, 5)

            Case "Collateral", "General", "Lower", "Upper"
                result = .Cells(lRow, 1) & " " & .Cells(lRow, 2) & " " & .Cells(lRow, 3)

            Case Else
                result = .Cells(lRow, 1) & " " & .Cells(lRow, 2)

        End Select

        .Cells(lRow, 10).Value = result
    Next lRow
End With

End Function

, Code 2, - 2 Case , String, :

Select Case .Cells(lRow, 4)
    Case "Base", "Inte", "Tier", "v", "Ba", "Bas", "Int", "Inte", "Inter", "Tie", "Tier-", "", "Upp", "Uppe", "Upper", "I", "L", "T"
        .Cells(lRow, 11) = ""

    Case "Design", "Inve", "Inv", "Low", "Lowe", "Proj", "Pro", "Ref", "Refi", "Refin", "Refina", "Refinanc", "Refinance", "Stock", "Inve", "LBO", "Working", "Work", "Wor", "Gre", _
             "Gree", "Green", "Interc", "Intercom", "Intercompany", "Intermed", "Refinanc", "Stoc", "No", "Pen", "Pens", "Pension", "Projec", "Project", _
             "Sto", "Stoc", "w", "Wor", "Tier-1", "Tier-2"
        .Cells(lRow, 11) = .Cells(lRow, 4)

End Select

, , , Select Case, Select Case.

""

Function fxr2()

Dim lRow As Long, LastRow As Long
Dim w As Workbook
Dim ws As Worksheet

Set w = ThisWorkbook
Set ws = w.Worksheets("Fixer") '<-- set the worksheet

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim type1 As String, result As String '<-- There no need to Dim them every time inside the loop

' use With statement, will simplify and shorten your code later
With ws
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row '<-- fully qualify Rows.Count with "Fixer" sheet

    For lRow = 7 To LastRow
        type1 = .Cells(lRow, 1).Text

        Select Case type1
            Case "Bail-in", "Investment", "Recapitalization", "Refinance", "Design"
                .Cells(lRow, 10).Value = .Cells(lRow, 1)

            Case "Basel"
                .Cells(lRow, 10).Value = .Cells(lRow, 1) & " " & .Cells(lRow, 2) & " " & .Cells(lRow, 3) & " " & .Cells(lRow, 4) & " " & .Cells(lRow, 5)

            Case "Collateral", "General", "Lower", "Upper"
                .Cells(lRow, 10).Value = .Cells(lRow, 1) & " " & .Cells(lRow, 2) & " " & .Cells(lRow, 3)

                ' ===== Added the Nested case here (just for example) =====
                 Select Case .Cells(lRow, 4)
                    Case "Base", "Inte", "Tier", "v", "Ba", "Bas", "Int", "Inte", "Inter", "Tie", "Tier-", "", "Upp", "Uppe", "Upper", "I", "L", "T"
                        .Cells(lRow, 11) = ""

                    Case "Design", "Inve", "Inv", "Low", "Lowe", "Proj", "Pro", "Ref", "Refi", "Refin", "Refina", "Refinanc", "Refinance", "Stock", "Inve", "LBO", "Working", "Work", "Wor", "Gre", _
                             "Gree", "Green", "Interc", "Intercom", "Intercompany", "Intermed", "Refinanc", "Stoc", "No", "Pen", "Pens", "Pension", "Projec", "Project", _
                             "Sto", "Stoc", "w", "Wor", "Tier-1", "Tier-2"
                        .Cells(lRow, 11) = .Cells(lRow, 4)

                End Select
                ' ==== End of Nested Select Case ====

            Case Else
                .Cells(lRow, 10).Value = .Cells(lRow, 1) & " " & .Cells(lRow, 2)

        End Select
    Next lRow
End With

End Function
+3

, IFs :

Select Case a
    Case 10
        Select Case b
            Case 1
                'a is 10, b is 1
            Case 2
                'a is 10, b is 2
            Case 3
                'a is 10, b is 3
        End Select
    Case 20
        Select Case b
            Case 1
                'a is 20, b is 1
            Case 2
                'a is 20, b is 2
            Case 3
                'a is 20, b is 3
        End Select
End Select
+1

, , , , , .

, VBA Microsoft. , , #. -, [FLAGS], . , .

, 7 (AAA, BBB, CCC, DDD, EEE, FFF, GGG), , . , . , - 1, - 2, - 4, - 8 ..

  • 27 , 1 + 2 + 8 + 16. (AAA, BBB, DDD, EEE)
  • 28 , 4 + 8 + 16. (CCC, DDD, EEE)

So, if we imagine that you have a number and want products, then something like this might work. The number is lngNumber, and LngToBinaryis the binary value of the number. In Sub TestMeinstead of printing products, you can do some action with them.

Option Explicit
Option Private Module

Public Sub TestMe()

    Dim arrProducts     As Variant
    Dim lngCounter      As Long
    Dim lngValue        As Long
    Dim strBinary       As String
    Dim lngNumber       As Long

    arrProducts = Array("AAA", "BBB", "CCC", "DDD", "EEE", "FFF", "GGG")
                           '1,     2,     4,     8,    16,    32,    64
    lngNumber = 28 '1+2+8+16
    strBinary = StrReverse(LngToBinary(lngNumber))

    For lngCounter = 1 To Len(strBinary)
        lngValue = Mid(strBinary, lngCounter, 1)

        If lngValue Then
            Debug.Print arrProducts(lngCounter - 1)
        End If

    Next lngCounter

End Sub

Function LngToBinary(ByVal n As Long) As String

    Dim k As Long

    LngToBinary = vbNullString

    If n < -2 ^ 15 Then
        LngToBinary = "0"
        n = n + 2 ^ 16
        k = 2 ^ 14

    ElseIf n < 0 Then

        LngToBinary = "1"
        n = n + 2 ^ 15
        k = 2 ^ 14

    Else

        k = 2 ^ 15

    End If

    Do While k >= 1
        LngToBinary = LngToBinary & Fix(n / k)
        n = n - k * Fix(n / k)
        k = k / 2
    Loop

End Function

Read more about [FLAGS] here: https://msdn.microsoft.com/en-us/library/system.flagsattribute(v=vs.110).aspx

+1
source

Source: https://habr.com/ru/post/1674729/


All Articles