Change cell value based on input numeric value according to the constant in the same cell

[gobikak20]

Hi every ones,

I have attached to the Water Board to enter a huge amount of data in Excel. But some of the character values are repeated in the same column. So, I decided to enter them by entering a SINGLE value.

But the current file is worked for Column M only.


VBA Code :
>>> use code - tags <<<

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const ColRangesList As String = "M,N,Q,R,U,X"
    Const RowRangesList As String = "AR5:AV5,AR6:AW6,AR7:AV7,AR8:AU8,AR9:AV9,AR11:AU11"
    
    Dim RowOffset As Long
    Dim ColOffset As Long
    
    RowOffset = 1
    ColOffset = 0
    
    If Target.Cells.CountLarge = 1 Then
        Dim ColRanges() As String: ColRanges = Split(ColRangesList, ",")
       
        Dim RowRanges() As String: RowRanges = Split(RowRangesList, ",")
        Dim CosRange As Range, RowsRange As Range, cel As Range
        Dim n As Long
        For n = 0 To UBound(ColRanges)
                
            Set CosRange = Columns(ColRanges(n))
            
            Set RowsRange = Range(RowRanges(n))
            If Not Intersect(Target, CosRange) Is Nothing Then
                Set cel = RowsRange.Find(Target.Value, RowsRange.Cells(RowsRange.Cells.Count), _
                    LookIn:=xlFormulas, LookAt:=xlWhole)
                If Not cel Is Nothing Then
                    Application.ScreenUpdating = False
                    Application.EnableEvents = False
                    Target.Value = cel.Offset((RowOffset), ColOffset).Value
                    Application.EnableEvents = True
                    Application.ScreenUpdating = True
                   'Exit For
                End If
            End If
        Next n
    End If

End Sub

Constants:
Column M (1:DM, 2:AG, 3:IW, 4:WSW, 5:CW)
Column N (1:DW, 2:AW, 3:TW, 4:TW/DW, 5:ATW, 6:O)
Column Q (1:Ag, 2:In, 3:Ur, 4:Ru, 5:Other)


Example :

If I enter 1 in column M, it should be change to DM
If I enter 4 in column M, it should be change to WSW,

If I enter 1 in column Q, it should be change to Ru
If I enter 3 in column Q, should be change to Ur

And so on as in the excel sheet.

 

[Marc L]

Hi !​

​

According to your attachment as a VBA beginner starter :​

Private Sub Worksheet_Change(ByVal Target As Range)
            Dim R&, C%
    With Target
        If .CountLarge = 1 Then
            If .Row > 6 And IsNumeric(.Value2) And .Value2 > 0 Then
                Select Case .Column
                       Case 13, 14: R = .Column - 7
                       Case 17:     R = 8
                       Case 18:     R = 14
                       Case 21:     R = 15
                       Case 24:     R = 17
                End Select
                    If R Then C = 45 + .Value2
                If C <= Columns.Count And C Then
                    Application.EnableEvents = False
                    .Value2 = Cells(R, C).Value2
                    Application.EnableEvents = True
                End If
            End If
        End If
    End With
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[gobikak20]

@Marc L , Thank you so much. And As I'm a beginner, could you explain this algorithm, please ?

 

[Marc L]

It affects the Constants area row # according to the active cell column …​

​

 

[Marc L]

Your original way corrected :​

Private Sub Worksheet_Change(ByVal Target As Range)
                 Const C = 45
                   Dim Rg As Range
    With Target
        If .CountLarge = 1 Then
            If .Column > 12 And .Column < 25 And .Row > 6 And IsNumeric(.Value2) And .Value2 > 0 Then
                   Set Rg = Me.UsedRange.Columns(C).Find(Cells(5, .Column).Value2, , , xlWhole)
                If Not Rg Is Nothing And C + .Value2 <= Columns.Count Then
                    Application.EnableEvents = False
                    .Value2 = Rg.Offset(, .Value2).Value2
                    Application.EnableEvents = True
                    Set Rg = Nothing
                End If
            End If
        End If
    End With
End Sub

You may Like it !​

​