color coding with vba

[saint_monkey]

excel has really crappy password protection for worksheets. passwords you enter are re-hashed by the computer and truncated to 12 digit strings, a good password cracker, like the one featured here:

http://www.mcgimpsey.com/excel/removepwords.html

can undo any protection you've placed on your worksheets in about two minutes,

as an illustration of this, and as an equally stupid method of protecting a worksheet, the first macro takes a character string and converts it into a color range on a worksheet. the second macro reads that string and your inputted password, and tells you if you have it right, or in this case, close. it is possible to shake things up a bit, since this password can be any length, and the seed is varied based upon user entry as well. of course it is quite easy to see how large the password is, as long as you know that the colored range corresponds to the size of the password. decyption could get hard, especially if the main page is full of random colors, and if only the decryption macro is in the target workbook.


Sub Code2Color()
'turns a password into a range of colored cells.
'
inp2cde = InputBox("Enter codestring")
lenstrin = Len(inp2cde)
if lenstrin < 7 then exit sub
seed = InputBox("Enter multiplier")
Count = 0
For x = 1 To lenstrin
Count = Count + 1
str2cde = Right(inp2cde, 1)
str2clr = Left(str2cde, 1)
numval = Asc(str2clr)


numval = Int(numval / seed)

ColVal = numval
Range("I" & Count).Interior.ColorIndex = ColVal


Next x
End Sub

Sub Color2Code()
' compliment to code2color, turns a range
' of cell interiors into a password
success = 1
Count = 0

inp2cde = InputBox("Enter your code")
lenstrin = Len(inp2cde)
if lenstrin < 7 then exit sub
seed = InputBox ("Enter multiplier")

For x = 1 To lenstrin

Count = Count + 1
str2cde = Right(inp2cde, 1)
str2clr = Left(str2cde, 1)
numval = Int(Asc(str2clr) / seed)

ColVal = Range("I" & Count).Interior.ColorIndex

If ColVal = numval Then
success = 0
Else
success = 1
End If

Next x
Select Case success
Case "0"
MsgBox "yup"
Case Else
MsgBox "nope"
End Select
End Sub