A challenging digit by digit manipulation, rotate the digit in range of 0 to 9

laucn · #4 05-16-2015, 10:32 PM

Quote:

Originally Posted by excelledsoftware

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

Wow, you're amazing. Tested it works perfectly.

My apologize for my mistake with cell C3 earlier.

Now i am able to refer to your codes and come out with 20+ other types of manipulations.

Really appreciate your great help and brilliant idea

One final add on if you don't mind....

My data sets contains 4000++ of rows.
i would like to to automatically populate new rows between existing rows of data.
And first columns of each newly populated row filled with "Manipulation 1", "Manipulation 2", "Manipulation 3", ... etc

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Outlook export to a calendar csv file is transposing single digit starting dates	sala-marie	Excel	3	10-27-2013 09:32 PM
Recipient counter in Mail Merge Wizard displays only one digit in Word	Liuneddu	Word	1	08-13-2013 03:57 AM
Import contact from EXCEL to Outlook (no zero in left side digit)	nmo111	Outlook	1	05-28-2010 11:00 AM
Dividing merge cell into ten equal rectangles for inputing Digit?	aligahk06	Excel	0	05-12-2010 06:56 AM
in WORD, how do i type a 9-digit phone number "xxxxxxxxx" and have it automatically..	jay8962	Word	0	04-08-2010 11:08 AM