Microsoft Office Forums A challenging digit by digit manipulation, rotate the digit in range of 0 to 9
 User Name Remember Me? Password
 Register FAQ Search Today's Posts Mark Forums Read

 Thread Tools Display Modes
#1
05-16-2015, 05:40 AM
 laucn Windows 7 64bit Office 2010 64bit Novice Join Date: May 2015 Posts: 9
A challenging digit by digit manipulation, rotate the digit in range of 0 to 9

Hi, i have set of data as below image:

1) All the data were formatted in Text as i would like to retain the leading zero. The manipulation result also need to retain the leading zero.
2) I would like to manipulate the data digit by digit, instead as a whole number.
3) The digit manipulation result rotates in range of 0 to 9 (0,1,2,3,4,5,6,7,8,9,0,1,2...), which means
3.1) 3 rotate forward 7 times become 0
3.2) 5 rotate forward 7 times become 2
3.3) 0 rotate backward 7 times become 3

For Manipulation 1:
-if the digit is in range of 1 to 5, rotate forward 7 times .
-if the digit is in range of 6 to 9, or 0, rotate backward 7 times.
For example, cell B2 is 3045, then the manipulation result be populated to cell B3 as 0312

For Manipulation 2:
-if the digit is 1,3,5,7, or 9, then rotate forward 7 times .
-if the digit is 2,4,6,8, or 0, then rotate backward 7 times.
For example, cell C2 is 6041, then the manipulation result be populated to cell C3 as 9178

Many thanks in advance
#2
05-16-2015, 05:21 PM
 excelledsoftware Windows 7 64bit Office 2003 IT Specialist Join Date: Jan 2012 Location: Utah Posts: 455

Challenging? You got my attention. I have the logic figured out for this and am working on coding it right now. I should have it done shortly.
#3
05-16-2015, 08:50 PM
 excelledsoftware Windows 7 64bit Office 2003 IT Specialist Join Date: Jan 2012 Location: Utah Posts: 455

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
#4
05-16-2015, 10:32 PM
 laucn Windows 7 64bit Office 2010 64bit Novice Join Date: May 2015 Posts: 9

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
#5
05-16-2015, 11:12 PM
 excelledsoftware Windows 7 64bit Office 2003 IT Specialist Join Date: Jan 2012 Location: Utah Posts: 455

Glad it worked. As for the additional add on I would be happy to help. I need to clarify a little further though.
Right now your data is set up to have a data row and then the manipulation rows below. If you want to add the row titles (Manipulation 1, Manipulation 2 etc.) Then I need to know how exactly you would want it to happen. Do you want to put in the data and then click a button that automatically fills in the manipulations based off of how many spaces there are between the data rows? Can you post a sample workbook with one worksheet that has the data you want to enter and then another worksheet that has the result of what you are looking for.
#6
05-16-2015, 11:16 PM
 excelledsoftware Windows 8 Office 2003 IT Specialist Join Date: Jan 2012 Location: Utah Posts: 455

By the way thank you for the kind words. It took a little thinking but I am happy with the result and even happier that this first part worked without any issues.
#7
05-16-2015, 11:39 PM
 laucn Windows 7 64bit Office 2010 64bit Novice Join Date: May 2015 Posts: 9

Quote:
 Originally Posted by excelledsoftware Glad it worked. As for the additional add on I would be happy to help. I need to clarify a little further though. Right now your data is set up to have a data row and then the manipulation rows below. If you want to add the row titles (Manipulation 1, Manipulation 2 etc.) Then I need to know how exactly you would want it to happen. Do you want to put in the data and then click a button that automatically fills in the manipulations based off of how many spaces there are between the data rows? Can you post a sample workbook with one worksheet that has the data you want to enter and then another worksheet that has the result of what you are looking for.
Hi, thanks for your quick response, i didn't expect this as i believe its now midnight at your area.

My data were imported from a text file.
The original piece of data looks like this:

On the earlier example, the rows of "Manipulation 1" and “Manipulation 2" were added with manual effort.
After execute the codes, i would like the Manipulation row to be added, and the calculation result to be populated respectively.
And outcome should looks like this, assuming i would like to add only two manipulation rows.

A button is not necessary, hit F5 execute the codes is good enough.

And many thanks again ^^
#8
05-16-2015, 11:43 PM
 excelledsoftware Windows 8 Office 2003 IT Specialist Join Date: Jan 2012 Location: Utah Posts: 455

lol Yes it is midnight but programmers are night owls well mostly haha. This will actually be really easy to write. Do do it effectively though we will need to have the original data on the first worksheet of your workbook and then we will have another worksheet added and place the data on there. Then we will go ahead and just run the code. Now this code will be written for 2 manipulations I am assuming you may want the ability to add more so I will give it some thought and see how I can code it to where you can update that in the future. I might be done tonight or sometime tomorrow. Thanks
#9
05-16-2015, 11:50 PM
 laucn Windows 7 64bit Office 2010 64bit Novice Join Date: May 2015 Posts: 9

Quote:
 Originally Posted by excelledsoftware lol Yes it is midnight but programmers are night owls well mostly haha. This will actually be really easy to write. Do do it effectively though we will need to have the original data on the first worksheet of your workbook and then we will have another worksheet added and place the data on there. Then we will go ahead and just run the code. Now this code will be written for 2 manipulations I am assuming you may want the ability to add more so I will give it some thought and see how I can code it to where you can update that in the future. I might be done tonight or sometime tomorrow. Thanks
lol, i was doing WinTel support few years back as well, now doing sales.
Still love to play with IT related things at my free time.

No worries, and take your time
#10
05-17-2015, 12:04 AM
 excelledsoftware Windows 8 Office 2003 IT Specialist Join Date: Jan 2012 Location: Utah Posts: 455

Yup pretty easy. You can put this bit of code in the same module. The variable called ManipRows will allow you to put in any amount of manipulations you want. If it were me I would then put an autoshape on the same sheet where I copy and paste the new data and assign the FormatManipulationSheet code to it. That way when you copy and paste your new data you can just press the button and then everything will be ran. As always save the book before running.
Code:
```Sub FormatManipulationSheet()
'Writes in the data from a worksheet and formats in a way to use the algorithm

Dim CheckRow As Long, ResultRow As Long, wb As Workbook, cws As Worksheet, rws As Worksheet
Dim LastRow As Long, ManipRows As Integer, Col As Integer, LastCol As Integer, Mrow As Long
Dim Mcount As Integer

'Set the amount of Manipulation Rows
ManipRows = 2

'Set the references
Set wb = ThisWorkbook
Set cws = wb.Worksheets(1)
Set rws = wb.Worksheets(2)
ResultRow = 2
LastRow = cws.Range("B2").End(xlDown).Row
LastCol = cws.Range("B2").End(xlToRight).Column

'Set up the headers
For Col = 2 To LastCol
rws.Cells(1, Col).Value = cws.Cells(1, Col).Value
Next Col

For CheckRow = 2 To LastRow
For Col = 2 To LastCol
rws.Cells(ResultRow, Col).Value = cws.Cells(CheckRow, Col).Value
Next Col
Mcount = 1
For Mrow = ResultRow + 1 To ResultRow + ManipRows
rws.Range("A" & Mrow).Value = "Manipulation " & Mcount
Mcount = Mcount + 1
Next Mrow
ResultRow = ResultRow + ManipRows + 1
Next CheckRow

'If you want to have the other code run right after
'just uncomment the 2 lines below.

'rws.Activate
'ManipulationAlg

End Sub```
Let me know if you have any questions or concerns.

Thanks
#11
05-17-2015, 12:05 AM
 excelledsoftware Windows 8 Office 2003 IT Specialist Join Date: Jan 2012 Location: Utah Posts: 455

That last bit of code depends on the data to be pasted on the 1st sheet and then it formats it on the 2nd sheet of the workbook.
#12
05-17-2015, 12:07 AM
 laucn Windows 7 64bit Office 2010 64bit Novice Join Date: May 2015 Posts: 9

Quote:
 Originally Posted by excelledsoftware That last bit of code depends on the data to pasted on the 1st sheet and then it formats it on the 2nd sheet of the workbook.
Wow, that's fast n great, thanks.
Will test it out and revert.
#13
05-17-2015, 12:13 AM
 excelledsoftware Windows 8 Office 2003 IT Specialist Join Date: Jan 2012 Location: Utah Posts: 455

Awesome let me know if you have any questions. I really appreciate being able to work on these types of things as it helps me improve my skills.
#14
05-17-2015, 02:12 AM
 laucn Windows 7 64bit Office 2010 64bit Novice Join Date: May 2015 Posts: 9

Quote:
 Originally Posted by excelledsoftware Awesome let me know if you have any questions. I really appreciate being able to work on these types of things as it helps me improve my skills.
You're fantastic, it works perfectly. Thanks, buddy
#15
05-17-2015, 12:12 PM
 excelledsoftware Windows 8 Office 2003 IT Specialist Join Date: Jan 2012 Location: Utah Posts: 455

No problem thanks for marking it solved. The only thing it is missing is a check for manipulation rows. Meaning if you run the second code with 3 manipulations and then the first with only 2 it will not give the desired results. Let me know if you need this change put in or not. Thanks again

 Thread Tools Display Modes Linear Mode

 Similar Threads Thread Thread Starter Forum Replies Last Post sala-marie Excel 3 10-27-2013 09:32 PM Liuneddu Word 1 08-13-2013 03:57 AM nmo111 Outlook 1 05-28-2010 11:00 AM aligahk06 Excel 0 05-12-2010 06:56 AM jay8962 Word 0 04-08-2010 11:08 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 01:15 PM.

 -- Default Style -- Lightweight -- New Mobile Contact Us - Privacy Statement - Top