Extracting and Manipulating Text from Cells.

[Living]

Hi,

This could be a bit complicated, but hopefully also useful for others. We have the following sample of 10 cells from a large file with similar data:

N: 1; B: 162; M: 278, 278; T: 24; A: 103, 105; I: 393; Ḥ: 7240, 7390, 7465, 7546, 7617, 7756, 27399, 8380, 8741, 8894, 8985, 9559, 9671, 9741, 10119, 10211; W: 40; D: 766.
N: 2; B: 246, 889, 1136; M: 255, 255; A: 55; I: 286; Ḥ: 22731, 22802, 22857, 22906, 22948; D: 685.
N: 3; B: 244; M: 254; A: 49; Ḥ: 19238.
N: 4; B: 2261, 6923; M: 1733, 1824; A: 2930, 3579, 4354; Ḥ: 19167.
N: 5; Ḥ: 23683, 23811, 24404, 24609, 25483; D: 684.
N: 6; B: 888; Ḥ: 12050; D: 681.
N: 7; B: 887, 7240; M: 252; T: 22; A: 46; I: 287; Ḥ: 7294, 7364, 7457, 7794, 8928, 8941, 9264, 9308, 9612, 10240, 10318, 10487; W: 147, 148; D: 683, 1484.
N: 8; M: 253, 253; A: 51; I: 290; Ḥ: 27601, 24274, 24958, 25020, 25064, 25466.
N: 9; B: 5889, 5891, 6297; M: 257; T: 2756; A: 4198; I: 292; Ḥ: 7092, 7220, 7754, 9066, 9965; W: 1709.
N: 10; B: 5889, 5891, 6297; M: 257; T: 2756; A: 4198; I: 292; Ḥ: 7092, 7220, 7754, 9066, 9965; W: 1709.

We want to extract the same letters with its numbers and put the same letters with numbers in one column and do this for all letters, but - this is important - while keeping them in their original row. The purpose of this is addition of data and easy rearrangement of the letter plus numbers order, e.g., to: B M N A T I W D Ḥ. As you can see not all the rows have all letters, nor are the seizes the same. There are thousands of such cells. Some parts are partly in bold, we want to maintain that layout after sorting. Such a thing should be easy for computers, but how could this extraction and manipulation be done (I have Excel 2010)?

P.S. There are two spaces after every ; that were eaten up here.

 

[Rick Rothstein]

Does this UDF (user defined function) do what you want...

Function Letters(S As String) As String
  Dim X As Long, Parts() As String
  Parts = Split(S, ":")
  Parts(0) = ""
  Parts(UBound(Parts)) = ""
  For X = 1 To UBound(Parts) - 1
    Parts(X) = Mid(Parts(X), InStrRev(Parts(X), " ") + 1)
  Next
  Letters = Trim(Join(Parts))
End Function

HOW TO INSTALL UDFs
------------------------------------
If you are new to UDFs, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. You can now use Letters just like it was a built-in Excel function. For example,

=Letters(A1)

 

[Living]

Dear Rick,

Thanks for your reply and for teaching us how to use UDFs. I tried the function, but the result was not right: the numbers were missing, they should be copied along with their letter and the end result should be 9 columns: 1 column for each letter plus numbers (basically just chopping the rows up).

 

[Rick Rothstein]

Dear Rick,

Thanks for your reply and for teaching us how to use UDFs. I tried the function, but the result was not right: the numbers were missing, they should be copied along with their letter and the end result should be 9 columns: 1 column for each letter plus numbers (basically just chopping the rows up).

Okay, I think I am misunderstanding what you want, so let me see if I can get it clarified. For this in, say, cell A1...

N: 6; B: 888; Ḥ: 12050; D: 681.

What do you can in B1? How about C1 and D1? Show me on different lines so I can tell, like this...

B1 - {you fill in here}

C1 - {you fill in here}

D1 - {you fill in here}

 

[Living]

Sorry, my example was a bit ambiguous: I was showing the letter order, not the end result. The 6th row would become:

B6 - B: 888;
C6 -
D6 - N: 6;
E6 -
F6 -
G6 -
H6 -
I6 - D: 681;
J6 - Ḥ: 12050

or the first column would become:

B: 162;
B: 246, 889, 1136;
B: 244;
B: 2261, 6923;

B: 888;
B: 887, 7240;

B: 5889, 5891, 6297;
B: 5889, 5891, 6297;

 

[Rick Rothstein]

Give this macro a try...

Sub DistributeOrderedData()
  Dim X As Long, Z As Long, LastRow As Long, Position As Long
  Dim Chars As String, Order(1 To 9) As String, Parts() As String
  Chars = "BMNATIWD"
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  For X = 1 To LastRow
    Erase Parts
    Parts = Split(Cells(X, "A").Value, ":")
    Erase Order
    For Z = 1 To UBound(Parts)
      Position = InStr(Chars, Right(Parts(Z - 1), 1))
      If Position = 0 Then Position = -9 * (AscW(Right(Parts(Z - 1), 1)) = 7716)
      If Position Then Order(Position) = Trim(Split(Parts(Z), ";")(0))
    Next
    Parts(0) = ""
    Parts(1) = ""
    Cells(X, "B").Resize(, 9) = Order
  Next
End Sub

 

[Living]

Ah, this is coming much closer to the goal, but now the letters are missing. They could remain and also the ; with two spaces and the . could also be turned into ; with two spaces. The bold is also gone; perhaps it's not possible to maintain this format with Excel, then I could hopefully paste into Word to redo the fattening and then paste everything back in Excel.

I would also like to rearrange the numbers of a letter to increasing order.

* HOW TO USE MACROS: www.mrexcel.com/articles/paste-macro-into-vbe.php (Developer tab, second from left)

 

[Rick Rothstein]

Ah, this is coming much closer to the goal, but now the letters are missing. They could remain and also the ; with two spaces and the . could also be turned into ; with two spaces. The bold is also gone; perhaps it's not possible to maintain this format with Excel, then I could hopefully paste into Word to redo the fattening and then paste everything back in Excel.

This should fix all of that....

Sub DistributeOrderedData()
  Dim X As Long, Z As Long, LastRow As Long, Position As Long
  Dim Chars As String, Order(1 To 9) As String, Parts() As String
  Chars = "BMNATIWD"
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  For X = 1 To LastRow
    Erase Parts
    Parts = Split(Cells(X, "A").Value, ":")
    Erase Order
    For Z = 1 To UBound(Parts)
      Position = InStr(Chars, Right(Parts(Z - 1), 1))
      If Position = 0 Then Position = -9 * (AscW(Right(Parts(Z - 1), 1)) = 7716)
      If Position Then
        Order(Position) = Right(Parts(Z - 1), 1) & ": " & Trim(Split(Parts(Z), ";")(0))
        If Right(Order(Position), 1) <> "." Then Order(Position) = Order(Position) & ";  "
        Order(Position) = Replace(Order(Position), ".", ";  ")
      End If
    Next
    Columns("D").Font.Bold = True
    Parts(0) = ""
    Parts(1) = ""
    Cells(X, "B").Resize(, 9) = Order
  Next
End Sub

I would also like to rearrange the numbers of a letter to increasing order.

Not sure which way you would want the sort... within the cell itself or down the column (sorted on the first number in the cell). Either way, I think doing it will take more code and slow down the execution speed of the macro.

 

[Living]

Wow, that's brilliant. Yes, within the cell; the order is sometimes messed up (in red below) and sorting that out manually from thousands of rows would be very difficult for humans, so it won't matter if the macro is a bit slow.

N: 1; B: 162; M: 278, 278; T: 24; A: 103, 105; I: 393; Ḥ: 7240, 7390, 7465, 7546, 7617, 7756, 27399, 8380, 8741, 8894, 8985, 9559, 9671, 9741, 10119, 10211; W: 40; D: 766.
N: 8; M: 253, 253; A: 51; I: 290; Ḥ: 27601, 24274, 24958, 25020, 25064, 25466.

 

[Rick Rothstein]

Wow, that's brilliant. Yes, within the cell; the order is sometimes messed up (in red below) and sorting that out manually from thousands of rows would be very difficult for humans, so it won't matter if the macro is a bit slow.

N: 1; B: 162; M: 278, 278; T: 24; A: 103, 105; I: 393; Ḥ: 7240, 7390, 7465, 7546, 7617, 7756, 27399, 8380, 8741, 8894, 8985, 9559, 9671, 9741, 10119, 10211; W: 40; D: 766.
N: 8; M: 253, 253; A: 51; I: 290; Ḥ: 27601, 24274, 24958, 25020, 25064, 25466.

Okay, so the sort is for the numbers within the cell only, and then for each letter's group of numbers individually... of course, that is the more troubling coding option. I can't look at it right at the moment, but I'll try to get to it later this evening (it is 3:10pm at my location right now) and see what I can do (unless someone picks up the challenge and handles it before I can get back to it).