简体   繁体   中英

VBA Excel multiple elseif statement

I would like to make a shorter code for multiple elseif statements

My code looks like this:

 Sub geography()
 Worksheets("Social").Rows("3:165").Hidden = True
 Dim cell As Range
  For Each cell In Range("F3:F165")
  If cell.Value = "GIS" Then
  Rows(cell.Row).EntireRow.Hidden = False
  ElseIf cell.Value = "CLIMATE" Then
  Rows(cell.Row).EntireRow.Hidden = False
  ElseIf cell.Value = "TRAVEL" Then
  Rows(cell.Row).EntireRow.Hidden = False
  ElseIf cell.Value = "TOURISM" Then
  Rows(cell.Row).EntireRow.Hidden = False
  ElseIf cell.Value = "WILDLIFE" Then
  Rows(cell.Row).EntireRow.Hidden = False
  End If
  Next
  End Sub

I found some similar thread here:

Eliminating multiple Elseif statements

but it applies to the range instead of the boolean, like in my case.

Regardless I built the code, based on my situation:

 Sub geography2()
  Dim arr, res
  Dim cell As Range
  Dim Variable As Boolean

  arr = Array(Array("GIS", False), _
            Array("CLIMATE", False), _
            Array("TRAVEL", False), _
            Array("TOURISM", False), _
            Array("WILDLIFE", False))
  res = Rows(cell.Row).EntireRow.Hidden
  If Not IsError(res) Then
    Variable = res
    End If
  End Sub 

but it doesn't work, as the debugger points the line:

   res = Rows(cell.Row).EntireRow.Hidden

and says: Object variable or with block variable not set

How can I cut down the bulk elseif statement then?

Hide Rows ( Match / Select Case )

  • The Select Case version is case-sensitive while the Application.Match version is not.

The Code

Option Explicit

Sub geographyMatch()
    
    Const RowNumbers As String = "3:165"
    Dim Criteria As Variant
    Criteria = Array("GIS", "CLIMATE", "TRAVEL", "TOURISM", "WILDLIFE")
    
    Worksheets("Social").Rows(RowNumbers).EntireRow.Hidden = True
    
    Dim rng As Range
    Dim cel As Range
    For Each cel In Worksheets("Social").Columns("F").Rows(RowNumbers)
        If Not IsError(Application.Match(cel.Value, Criteria, 0)) Then
            If Not rng Is Nothing Then
                Set rng = Union(rng, cel)
            Else
                Set rng = cel
            End If
        End If
    Next cel
    
    If Not rng Is Nothing Then
        rng.EntireRow.Hidden = False
    End If

End Sub

Sub geographySelectCase()
    
    Const RowNumbers As String = "3:165"
    
    Worksheets("Social").Rows(RowNumbers).EntireRow.Hidden = True
    
    Dim rng As Range
    Dim cel As Range
    For Each cel In Worksheets("Social").Columns("F").Rows(RowNumbers)
        Select Case cel.Value
            Case "GIS", "CLIMATE", "TRAVEL", "TOURISM", "WILDLIFE"
                If Not rng Is Nothing Then
                    Set rng = Union(rng, cel)
                Else
                    Set rng = cel
                End If
        End Select
    Next cel
    
    If Not rng Is Nothing Then
        rng.EntireRow.Hidden = False
    End If

End Sub

To eliminate multiple elseifs, or arrays, try combining if statements with regular expression

Make sure you enable regular expression on: Tools > References > checkbox: "Microsoft VBScript Regular Expressions 5.5"

The function will look for the strings you mentioned ("GIS|CLIMATE|TRAVEL|TOURISM|WILDLIFE") and return True if it passes the regex test, it unhides the cell

Please let me know if it works, if not lets try solving it!

Thanks,

Option Explicit
Dim wb As Workbook

Dim cel As Range
Dim sRng As Range

Dim regex As New RegExp

Sub foo()

Set wb = ThisWorkbook
Set sRng = wb.Sheets("Social").Range("F3:F165")

wb.Sheets("Social").Rows("3:165").Hidden = True


For Each cel In sRng

    If chkexist(cel.Value, "GIS|CLIMATE|TRAVEL|TOURISM|WILDLIFE") = True Then
    
        cel.EntireRow.Hidden = False
    
    Else
    
    End If

Next cel


End Sub


Private Function chkexist(ByRef chkstr As String, ByVal patstr As String) As Boolean

'function that tests str if contains regex pattern
'returns boolean

With regex
    
    .Global = True
    .Pattern = patstr
    
End With

chkexist = regex.Test(chkstr)


End Function

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM