View Single Post
 
Old 05-16-2015, 08:50 PM
excelledsoftware excelledsoftware is offline Windows 7 64bit Office 2003
IT Specialist
 
Join Date: Jan 2012
Location: Utah
Posts: 455
excelledsoftware will become famous soon enough
Default

Got it. Took me some time since the result you provided for manipulation 2 is actually inaccurate. You specify on the 3.3 that 0 should become 3 when going backwards 7 times yet the result you wanted for C3 was 9178 when it actually should and would be 9378. In any case copy and paste the following code into a module in your workbook. Save the workbook then run and see if it does what you want. To insert code press ALT + F11 then go to insert >Module > then paste the code. To run place your cursor between Sub and End Sub and press F5.

A couple of notes. This code is made with the intention that the data is exactly how you describe so if you are off by a row it will override all data. Be sure to save and make a back up before running.

Code:
Option Explicit
Sub ManipulationAlg()
  Dim cr As Integer, CheckString As String, StringArray As Variant, x As Integer
  Dim Col As Integer, LastCol As Integer, CheckRow As Integer, LastRow As Integer
  Dim NewString As String, arr As Integer, ChangeChar As Integer, HoldString As String
  
  'Identify where to stop
  LastCol = Range("B2").End(xlToRight).Column
  LastRow = Range("B50000").End(xlUp).Row + 2
  
  For CheckRow = 2 To LastRow
    'Manipulation 1
    For Col = 2 To LastCol
      CheckString = Cells(CheckRow, Col)
      'Convert string into useable array
      HoldString = ""
      For cr = 1 To Len(CheckString)
        HoldString = HoldString & Mid(CheckString, cr, 1) & ","
      Next cr
      HoldString = Mid(HoldString, 1, Len(HoldString) - 1) 'remove last comma
      StringArray = Split(HoldString, ",")
      'Perform the manipulations
      For arr = 0 To UBound(StringArray)
        ChangeChar = StringArray(arr)
        Select Case StringArray(arr)
          Case 1 To 5
            For x = 1 To 7
              ChangeChar = ChangeChar + 1
              If ChangeChar = 10 Then ChangeChar = 0
            Next x
          Case 6 To 9, 0
            For x = 1 To 7
              ChangeChar = ChangeChar - 1
              If ChangeChar = -1 Then ChangeChar = 9
            Next x
        End Select
        'Change the array value
        StringArray(arr) = ChangeChar
      Next arr
      'Export the result
      NewString = ""
      For arr = 0 To UBound(StringArray)
        NewString = NewString & StringArray(arr)
      Next arr
      Cells(CheckRow + 1, Col).Value = NewString
      NewString = ""
      
      'Manipulation 2
      StringArray = Split(HoldString, ",")
      For arr = 0 To UBound(StringArray)
        ChangeChar = StringArray(arr)
        Select Case StringArray(arr)
          Case 1, 3, 5, 7, 9
            For x = 1 To 7
              ChangeChar = ChangeChar + 1
              If ChangeChar = 10 Then ChangeChar = 0
            Next x
          Case 2, 4, 6, 8, 0
            For x = 1 To 7
              ChangeChar = ChangeChar - 1
              If ChangeChar = -1 Then ChangeChar = 9
            Next x
        End Select
        StringArray(arr) = ChangeChar
      Next arr
      'Export the result
      NewString = ""
      For arr = 0 To UBound(StringArray)
        NewString = NewString & StringArray(arr)
      Next arr
      Cells(CheckRow + 2, Col).Value = NewString
      NewString = ""
    Next Col
    CheckRow = CheckRow + 2
  Next CheckRow
  
  MsgBox "done"
  
End Sub
Let me know if you have any questions.

Thanks
Reply With Quote