Excel vba - multiple conditions and multiple statements - vba

Question

I am very new to VBA coding and need some help. I'm looking for a code that selects ranges based on the value of differet cells.
In my sheet i have 7 cells that have a formula which give the cell a "X" if i want an range is to be selected:
If I33 = "X" then select A1: S31 (I33 has a formula)
If I34 = "X" then select T1: AH31 (I33 has a formula)
I have 7 of these ....
What I'm looking for; if one or more of I33, I34, i35, I36, I37, I38 or I39 has an "X", the respective area (example A1:S31, there are 7 different ranges) should be selected.
Thanks for any help :-)

Answer 1

you can try this
Option Explicit
Sub main()
Dim xRangeAdress As Range, rangesAddress() As Range, rangeToSelect As Range, cell As Range
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("X-Sheet") '<== change it as per your actual sheet name
Set xRangeAdress = ws.Range("I33:I39") '<== set the range with "X" formulas: change "I33:I39" as per your actual needs
Call SetRangeAddresses(rangesAddress(), ws) ' call the sub you demand the addresses settings to
For Each cell In xRangeAdress 'loop through "X" cells
If UCase(cell.Value) = "X" Then Set rangeToSelect = MyUnion(rangeToSelect, rangesAddress(cell.Row - 33 + 1)) ' if there's an "X" then update 'rangeToSelect' range with corresponding range
Next cell
rangeToSelect.Select
End Sub
Sub SetRangeAddresses(rangeArray() As Range, ws As Worksheet)
ReDim rangeArray(1 To 7) As Range '<== resize the array to as many rows as cells with "X" formula
With ws ' type in as many statements as cells with "X" formula
Set rangeArray(1) = .Range("A1:S31") '<== adjust range #1 as per your actual needs
Set rangeArray(2) = .Range("T1:AH31") '<== adjust range #2 as per your actual needs
Set rangeArray(3) = .Range("AI1:AU31") '<== adjust range #3 as per your actual needs
Set rangeArray(4) = .Range("AU1:BK31") '<== adjust range #4 as per your actual needs
Set rangeArray(5) = .Range("BL1:BT31") '<== adjust range #5 as per your actual needs
Set rangeArray(6) = .Range("BU1:CD31") '<== adjust range #6 as per your actual needs
Set rangeArray(7) = .Range("CE1:CJ31") '<== adjust range #7 as per your actual needs
End With
End Sub
Function MyUnion(rng1 As Range, rng2 As Range) As Range
If rng1 Is Nothing Then
Set MyUnion = rng2
Else
Set MyUnion = Union(rng1, rng2)
End If
End Function
I added comments to let you study and develop his code for your further knowledge

Answer 2

Just to have a different solution (regarding what you need choose one of them):
Option Explicit
Function MainFull(Optional WS As Variant) As Range
If VarType(WS) = 0 Then
Set WS = ActiveSheet
ElseIf VarType(WS) <> 9 Then
Set WS = Sheets(WS)
End If
With WS
Dim getRng As Variant, outRng As Range, i As Long
getRng = WS.Range("I33:I39").Value
For i = 1 To 7
If getRng(i, 1) = "x" Then
If MainFull Is Nothing Then
Set MainFull = .Range(Array("A1:S31", "T1:AL31", "AM1:BE31", "BF1:BX31", "BY1:CQ31", "CR1:DJ31", "DK1:EC31")(i - 1)) '<- change it to fit your needs
Else
Set MainFull = Union(MainFull, .Range(Array("A1:S31", "T1:AL31", "AM1:BE31", "BF1:BX31", "BY1:CQ31", "CR1:DJ31", "DK1:EC31")(i - 1))) '<- change it to fit your needs
End If
End If
Next
End With
End Function
Function MainArray(Optional WS As Variant) As Variant
If VarType(WS) = 0 Then
Set WS = ActiveSheet
ElseIf VarType(WS) <> 9 Then
Set WS = Sheets(WS)
End If
With WS
Dim getRng As Variant, outArr() As Variant, i As Long, j As Long
getRng = WS.Range("I33:I39").Value
i = Application.CountIf(WS.Range("I33:I39"), "x")
If i = 0 Then Exit Function
ReDim outArr(1 To i)
For i = 1 To 7
If getRng(i, 1) = "x" Then
j = j + 1
Set outArr(j) = .Range(Array("A1:S31", "T1:AL31", "AM1:BE31", "BF1:BX31", "BY1:CQ31", "CR1:DJ31", "DK1:EC31")(i - 1)) '<- change it to fit your needs
End If
Next
End With
MainArray = outArr
End Function
MainFull returns the whole range for all marked ranges while MainArray returns an array which holds all ranges which are marked with "x".
How to use it:
For MainFull you can simply set the range via Set myRange = MainFull("Sheet1"). This way it can easily used within another macro (sub) to copy/paste it somewhere.
But if you need to repeat this process for every set range (which is marked by "x") then the second sub is needed like:
Dim myRange As Variant
For Each myRange In MainArray("Sheet1")
....
Next
Then do all the stuff via myRange. If you still have any questions, just ask ;)