cell masking with a password

cell-masking.vba

'Full code on finish
'You can change H4, 6, 26, and H to other cell references

Function KeyCell() As String
    KeyCell =3D "H4"
End Function

Function RowStart() As Integer
    RowStart =3D 6
End Function

Function RowEnd() As Integer
    RowEnd =3D 26
End Function

Function PriceColumn() As String
    PriceColumn =3D "H"
End Function

Private Sub CommandButton1_Click()
    Dim PriceCol As String
    PriceCol =3D PriceColumn()
    Dim KeyChars() As String
    KeyChars =3D MakeKey(KeyCell())
    'KeyChars is now the correct mapping with last character equaling zero
    For Row =3D RowStart() To RowEnd()
        Cells(Row, PriceCol).Value =3D CodePrices(Cells(Row, PriceCol),
KeyChars)
    Next
End Sub

Function CodePrices(Price As String, Cipher() As String) As String
    Dim Code As String
    For i =3D 1 To Len(Price)
        Digit =3D Mid$(Price, i, 1)
        If IsNumeric(Digit) Then
            Code =3D Code + Cipher(Digit)
        Else
            Code =3D Code + Digit
        End If
    Next
    CodePrices =3D Code
End Function

Function MakeKey(Cell As String) As String()
    Dim Key As String
    Dim KeyChars() As String
    Key =3D UCase(Range(Cell))
    Key =3D Replace(Key, " ", "")
    ReDim KeyChars(Len(Key) - 1)
    For i =3D 1 To Len(Key) - 1
      KeyChars(i) =3D Mid$(Key, i, 1)
    Next
    KeyChars(0) =3D Mid$(Key, Len(Key), 1)
    MakeKey =3D KeyChars
End Function

Private Sub CommandButton2_Click()
    Dim PriceCol As String
    PriceCol =3D PriceColumn()
    Dim KeyChars() As String
    KeyChars =3D MakeKey(KeyCell())
    'KeyChars is now the correct mapping with last character equaling zero
    For Row =3D RowStart() To RowEnd()
        Cells(Row, PriceCol).Value =3D DecodeToPrices(Cells(Row, PriceCol),
KeyChars)
    Next
End Sub

Function DecodeToPrices(Code As String, Cipher() As String) As String
    Code =3D Replace(Code, "RMB", "$$$")
    Dim Prices As String
    For i =3D 1 To Len(Code)
        Char =3D Mid$(Code, i, 1)
        Pos =3D Application.Match(Char, Cipher, 0)
        If Not WorksheetFunction.IsNA(Pos) Then
            Prices =3D Prices + CStr(Pos - 1)
        Else
            Prices =3D Prices + Char
        End If
    Next
    Prices =3D Replace(Prices, "$$$", "RMB")
    DecodeToPrices =3D Prices
End Function