Macros to Encode and Decode the Sheet
[Please check both the Macros by copying into VB Editor of Any Excel file. Then RUN the Macro.]
Sub Encode_the_Sheet_Selected_Rows_N_Columns()
On Error GoTo ERR
Dim S1, S2 As Variant
Dim change(20), CHANGE2(20), l, M As Integer
Dim ic, lc, ir, lr, hello, J, k As Long
For I = 1 To 20
If I < 11 Then
change(I - 1) = I * I
CHANGE2(I - 1) = I * 4
Else
change(I - 1) = I * 3
CHANGE2(I - 1) = I * 2
End If
Next
ic = Int(InputBox("Enter begining Column No from where you want to Encode the Data."))
If ic < 1 Or ic = Empty Then ic = 1
lc = Int(InputBox("Enter Last Column No upto where you want to Encode the Data."))
If lc < ic Or lc = Empty Then
hello = lc
lc = ic
ic = hello
End If
ir = Int(InputBox("Enter begining Row No from where you want to Encode the Data."))
If ir < 1 Or ir = Empty Then ir = 1
lr = Int(InputBox("Enter Last Row No upto where you want to Encode the Data."))
If lr < ir Or lr = Empty Then
hello = lr
lr = ir
ir = hello
End If
M = 0
For J = ir To lr
For k = ic To lc
S1 = ""
S1 = """" & Sheets("Sheet1").Cells(J, k).NumberFormat & """"
S1 = S1 & Sheets("Sheet1").Cells(J, k).Value
Sheets("Sheet1").Cells(J, k).NumberFormat = "General"
S2 = """"
l = 0
For I = 1 To Len(S1)
S2 = S2 & Chr(Asc(Mid(S1, I, 1)) + change(l) + CHANGE2(M))
l = l + 1
If l > 19 Then l = 0
Next
M = M + 1
If M > 19 Then M = 0
Sheets("Sheet1").Cells(J, k).Value = S2
Next
Next
Exit Sub
ERR:
MsgBox ERR.Number & " " & ERR.Description
End Sub
Sub Decode_the_Sheet_Selected_Rows_N_Columns()
On Error GoTo ERR
Dim S1, S2, s3 As Variant
Dim change(20), CHANGE2(20), l As Integer
Dim ic, lc, ir, lr, hello, J, k As Long
For I = 1 To 20
If I < 11 Then
change(I - 1) = I * I
CHANGE2(I - 1) = I * 4
Else
change(I - 1) = I * 3
CHANGE2(I - 1) = I * 2
End If
Next
MsgBox ("You are required to tell exact Begining and End Columns and Rows Nos. of Encoded Data.")
ic = Int(InputBox("Enter begining Column No of the Encoded Data."))
If ic < 1 Or ic = Empty Then ic = 1
lc = Int(InputBox("Enter Last Column No of the Encoded Data."))
If lc < ic Or lc = Empty Then
hello = lc
lc = ic
ic = hello
End If
ir = Int(InputBox("Enter begining Row No of the Encoded Data."))
If ir < 1 Or ir = Empty Then ir = 1
lr = Int(InputBox("Enter Last Row No of the Encoded Data."))
If lr < ir Or lr = Empty Then
hello = lr
lr = ir
ir = hello
End If
M = 0
For J = ir To lr
For k = ic To lc
S1 = ""
S1 = Sheets("Sheet1").Cells(J, k).Value
S2 = ""
l = 0
For I = 2 To Len(S1)
S2 = S2 & Chr(Asc(Mid(S1, I, 1)) - (change(l) + CHANGE2(M)))
l = l + 1
If l > 19 Then l = 0
Next
For I = 2 To Len(S2)
If Mid(S2, I, 1) = """" Then
s3 = Mid(S2, 2, I - 2)
S1 = Right(S2, Len(S2) - I)
Exit For
End If
Next
M = M + 1
If M > 19 Then M = 0
If Left(S2, 1) = """" And I <= Len(S2) Then
Sheets("Sheet1").Cells(J, k).Value = S1
Sheets("Sheet1").Cells(J, k).Select
Selection.NumberFormat = s3
End If
Next
Next
Exit Sub
ERR:
MsgBox ERR.Number & " " & ERR.Description
End Sub
Namaskar! I am Anurag Pandey (since 1978). I am writer, author, poet, lyricist and computer programmer. My poems have been published in national newspapers and magazines of India like Navbharat Times, Kadambini etc. I have written Story/ Dialogues/ Screenplay for various TV Shows like Lady Inspector, Shaka Laka Boom Boom, Indonesian TV shows etc. At present I live in Bhubaneswar, India. Meditation, yoga, mystery, paranormal, supernatural, love, relationships are some of my favorite topics to read and write.
I use coding to automate required tasks in my office, which have reduced particular tasks completion time from hours and even days to just a few minutes.