VBA auto populating from column BB to BD depending on the results in Column BB-CodePudding

I'm trying to figure out a way to auto populate from one column to another. Once the Numbers are in column BB depending on the numbers in column BB like this is the logic I'm trying to figure out in code.

If column BB is greater than 0 or equal to 19 then column BD would write "black" down the columns.

If Column BB is greater than 20 or equal to 99 then column BD would write "grey" down the columns.

If Column BB is greater than 100 or equal to 199 then column BD would write "white" down the columns.

I wasn't able to figure out a solution.

CodePudding user response：

Like this? :

=SWITCH(TRUE,AND(B1>=0,B1<=19),"Black",AND(B1>=20,B1<=99),"Grey",AND(B1>=100,B1<=199),"White","OUT OF RANGE")

CodePudding user response：

Since you seem to have an aversion to formulas, here are three ways to do it with macros:

1) UDF
Basically just taking the whole formula logic from the previous answer and combining it into one convenient UDF:

Option Explicit
Function WhiteGreyBlack(Ref As Range) As String
    
    Dim N As Long
    
    N = CLng(Ref.Value)
    
    Select Case True
        Case N >= 0 And N <= 19
            WhiteGreyBlack = "Black"
        Case N >= 20 And N <= 99
            WhiteGreyBlack = "Grey"
        Case N >= 100 And N <= 199
            WhiteGreyBlack = "White"
        Case Else
            WhiteGreyBlack = "OUT OF RANGE"
    End Select
    
End Function

2) Range Looping Same exact logical section, we're just iterating through the range and placing results as unchanging values

Option Explicit
Sub WhiteGreyBlackRange()
    
    Dim RG As Range
    Dim CL As Range
    Dim OS As Long
    Dim N As Long
    Dim lRow As Long
    
    On Error GoTo ErrorWithRange
    
    Set RG = Application.InputBox( _
        Title:="Select Range", _
        Prompt:="Select the Range of cells to test", _
        Type:=8)
    If RG Is Nothing Then GoTo ErrorWithRange
    If RG.Cells.Count > 3000 Then GoTo ErrorWithRange
    If RG.Columns.Count > 1 Then GoTo ErrorWithRange
    
    On Error GoTo MiscError
    
    OS = Application.InputBox( _
        Title:="Select Offset", _
        Prompt:="Enter how far Offset you want the result:" & vbCrLf & vbCrLf & _
                """ 1"" = one column to the right" & vbCrLf & _
                """-3"" = Three columns to the right")
    If OS = 0 Then
        MsgBox "Offset Must not equal 0", vbOKOnly   vbCritical, "Error"
        Exit Sub
    End If
    
    For Each CL In RG.Cells
        N = CL.Value
        Select Case True
            Case N >= 0 And N <= 19
                CL.Offset(0, OS).Value = "Black"
            Case N >= 20 And N <= 99
                CL.Offset(0, OS).Value = "Grey"
            Case N >= 100 And N <= 199
                CL.Offset(0, OS).Value = "White"
            Case Else
                CL.Offset(0, OS).Value = "OUT OF RANGE"
        End Select
    Next CL
      
Exit Sub
MiscError:
    MsgBox "Unknown Error", vbCritical   vbOKOnly, "Error"
Exit Sub
ErrorWithRange:
    MsgBox "Please select only one vertical line of cells, " & vbCrLf & _
            "Please do not select the entire column." & vbCrLf & _
            "Please do not select more than 3000 cells at a time", _
            vbOKOnly   vbCritical, _
            "Error with range selection... "
End Sub

3) Array Looping
Best option for very large data sets.
You could incorporate the same user input and error handling options from the Range looping if you felt the need.

Option Explicit
Sub WhiteGreyBlackArray()
    
    Dim RG As Range
    Dim RGOut As Range
    Dim ValArray
    Dim I As Long
    
    Set RGOut = Sheet1.Range("F2:F34")
    Set RG = Sheet1.Range("B2:B34")
    ValArray = RG
    
    For I = 1 To UBound(ValArray, 1)
        Select Case True
            Case ValArray(I, 1) >= 0 And ValArray(I, 1) <= 19
                ValArray(I, 1) = "Black"
            Case ValArray(I, 1) >= 20 And ValArray(I, 1) <= 99
                ValArray(I, 1) = "Grey"
            Case ValArray(I, 1) >= 100 And ValArray(I, 1) <= 199
                ValArray(I, 1) = "White"
            Case Else
                ValArray(I, 1) = "OUT OF RANGE"
        End Select
    Next I
        
    RGOut = ValArray

End Sub

All 4 are great options: