Successive retrieval of defined ranges, by splitting thier names in a constant as well as a dynamic-CodePudding

The following code should be part of a parking management tool. It is basically nothing more than a conditional formatting of parking spaces in the form of defined ranges in a sheet "GF" based on an associated status defined as a string in a list object in a sheet "GF List".

Unlike the example below, the code is to be applied later to several hundred parking spaces with eight possible formattings, so I want to solve the whole thing using a VBA procedure instead of the standard conditional formatting.

The code fails because I can't dynamically retrieve the "CurrentLot" as a Range to then format it in the IfThenElse procedure.

I hope that you guys can help me. Thanks a lot.

Sub No_01_to_05a()

Dim gfList As Worksheet
Dim gfPlan As Worksheet
Dim status As String
Dim CurrentLot As Range
Dim i As Integer
Dim No As String

Set gfList = ThisWorkbook.Worksheets("GF List")
Set gfPlan = ThisWorkbook.Worksheets("GF")


'Parking lots that are defined manually here
Dim LotNo1 As Range
Set LotNo1 = gfPlan.Range("B2", "C2")

Dim LotNo2 As Range
Set LotNo2 = gfPlan.Range("D2", "E2")

Dim LotNo3 As Range
Set LotNo3 = gfPlan.Range("F2", "G2")

Dim LotNo4 As Range
Set LotNo4 = gfPlan.Range("H2", "I2")

Dim LotNo5 As Range
Set LotNo5 = gfPlan.Range("J2", "K2")

Dim LotNo5a As Range
Set LotNo5a = gfPlan.Range("M2", "M3")

'ForNext procedure
For i = 4 To gfList.Range("E" & Application.Rows.Count).End(xlUp).Row
    
    status = gfList.Range("E" & i).Value
    No = gfList.Range("B" & i).Value
    CurrentLot = "LotNo" & No 'Line that does not seem to work
    
        If status = "Vacant" Then
                CurrentLot.Interior.Color = RGB(255, 255, 0)
                CurrentLot.Font.Color = RGB(0, 0, 0)
    
        ElseIf status = "Let" Then
                CurrentLot.Interior.Color = RGB(146, 208, 80)
                CurrentLot.Font.Color = RGB(0, 0, 0)

        ElseIf status = "Reserved" Then
                CurrentLot.Interior.Color = RGB(0, 176, 240)
                CurrentLot.Font.Color = RGB(0, 0, 0)
                
        Else
                CurrentLot.Interior.Color = RGB(255, 255, 255)
                CurrentLot.Font.Color = RGB(0, 0, 0)     
        End If
                  
Next i

End Sub

CodePudding user response：

You cannot assign a variable resp. object to another variable/object just by assigning a string to that variable which is just the same as the name of the variable. That's what you seem to want to do with CurrentLot = "LotNo" & No

You have to do use a Select Case statement to achieve that

Option Explicit

Sub No_01_to_05a()

    Dim gfList As Worksheet
    Set gfList = ThisWorkbook.Worksheets("GF List")
    Dim status As String
    Dim CurrentLot As Range
    Dim i As Integer
    Dim No As String

    'ForNext procedure
    For i = 4 To gfList.Range("E" & Application.Rows.Count).End(xlUp).Row
    
        status = gfList.Range("E" & i).Value
        No = gfList.Range("B" & i).Value
        'CurrentLot = "LotNo" & No   <= You cannot assign a string to a range
        Set CurrentLot = getLot(No)
    
        If status = "Vacant" Then
            CurrentLot.Interior.Color = RGB(255, 255, 0)
            CurrentLot.Font.Color = RGB(0, 0, 0)
    
        ElseIf status = "Let" Then
            CurrentLot.Interior.Color = RGB(146, 208, 80)
            CurrentLot.Font.Color = RGB(0, 0, 0)

        ElseIf status = "Reserved" Then
            CurrentLot.Interior.Color = RGB(0, 176, 240)
            CurrentLot.Font.Color = RGB(0, 0, 0)
                
        Else
            CurrentLot.Interior.Color = RGB(255, 255, 255)
            CurrentLot.Font.Color = RGB(0, 0, 0)
        End If
                  
    Next i

End Sub

Function getLot(ByVal No As Long) As Range
    
    Dim gfPlan As Worksheet
    Set gfPlan = ThisWorkbook.Worksheets("GF")
    
    'Parking lots that are defined manually here
    Dim LotNo1 As Range
    Set LotNo1 = gfPlan.Range("B2", "C2")

    Dim LotNo2 As Range
    Set LotNo2 = gfPlan.Range("D2", "E2")

    Dim LotNo3 As Range
    Set LotNo3 = gfPlan.Range("F2", "G2")

    Dim LotNo4 As Range
    Set LotNo4 = gfPlan.Range("H2", "I2")

    Dim LotNo5 As Range
    Set LotNo5 = gfPlan.Range("J2", "K2")

    Dim LotNo5a As Range
    Set LotNo5a = gfPlan.Range("M2", "M3")
    Select Case No
        Case 1
            Set getLot = LotNo1
        Case 2
            Set getLot = LotNo2
        Case 3
            Set getLot = LotNo3
        Case 4
            Set getLot = LotNo4
        Case 5
            Set getLot = LotNo5
        Case Else
            '
    End Select
End Function

Further reading on Select Case statement.

CodePudding user response：

VBA does not have this feature to evaluate expressions inside the language, so since the lot No is not always a number, you could use a Dictionary to save the lots with the No as keys

Sub No_01_to_05a()

    Dim gfList As Worksheet
    Dim gfPlan As Worksheet
    Dim status As String
    Dim CurrentLot As Range
    Dim i As Integer
    Dim No As String
    Dim dictLot As Object
    
    Set dictLot = CreateObject("Scripting.Dictionary")
    
    Set gfList = ThisWorkbook.Worksheets("GF List")
    Set gfPlan = ThisWorkbook.Worksheets("GF")
    
    dictLot "1", gfPlan.Range("B2", "C2")
    dictLot "2", gfPlan.Range("D2", "E2")
    dictLot "3", gfPlan.Range("F2", "G2")
    dictLot "4", gfPlan.Range("H2", "I2")
    dictLot "5", gfPlan.Range("J2", "K2")
    dictLot "5a", gfPlan.Range("M2", "M3")
    
    'ForNext procedure
    For i = 4 To gfList.Range("E" & Application.Rows.Count).End(xlUp).row
        
        status = gfList.Range("E" & i).Value
        No = gfList.Range("B" & i).Value

        If Not dictLot.Exists(No) Then
            MsgBox "Lot: " & No & " does not exists.", vbInformation ' Show a message when the lot does not exists
            Exit For
        End If
        
        Set CurrentLot = dictLot(No) ' Retrieve the lot using the No as key in the dictionary
        
        If status = "Vacant" Then
            CurrentLot.Interior.Color = RGB(255, 255, 0)
            CurrentLot.Font.Color = RGB(0, 0, 0)
        ElseIf status = "Let" Then
            CurrentLot.Interior.Color = RGB(146, 208, 80)
            CurrentLot.Font.Color = RGB(0, 0, 0)
        ElseIf status = "Reserved" Then
            CurrentLot.Interior.Color = RGB(0, 176, 240)
            CurrentLot.Font.Color = RGB(0, 0, 0)
        Else
            CurrentLot.Interior.Color = RGB(255, 255, 255)
            CurrentLot.Font.Color = RGB(0, 0, 0)
        End If
                      
    Next i

End Sub

Here more info about Dictionary