Two of 51 Macros from this book are given below: 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 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 ...
Read More
Two of 51 Macros from this book are given below: 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 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 lc = Int(InputBox("Enter Last Column No upto where you want to Encode the Data.")) If lc 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 lr = Int(InputBox("Enter Last Row No upto where you want to Encode the Data.")) If lr 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 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 lc = Int(InputBox("Enter Last Column No of the Encoded Data.")) If lc hello = lc lc = ic ic = hello End If ir = Int(InputBox("Enter begining Row No of the Encoded Data.")) If ir lr = Int(InputBox("Enter Last Row No of the Encoded Data.")) If lr 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 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
Read Less
