Dividing the cell at exactly the right place

[CaptainCsaba]

Hi!

So here is the problem. We get a PDF report, and since it is not that well made, when we extract it into excel All the different columns get put into column one together. We only need a few lines from there that I managed to offset (so some cells in column D are empty) and from these lines we get to a point that is beyond my capabilities. We need to divide the cell into two different cells at exactly the right place, but because of the conversion this changes every time. I managed to figure out a way but I don't know how to put it into VBA. here are a few lines:

[TABLE="width: 417"]
<tbody>[TR]
[TD="width: 417"](Ref: ABN97) 1,353,255 JUPITER ASSET MANAGEMENT
[TABLE="width: 417"]
<tbody>[TR]
[TD="width: 417"][TABLE="width: 417"]
<tbody>[TR]
[TD="width: 417"](Ref: 16127) 325,000NFU MUTUAL[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="width: 417"]
<tbody>[TR]
[TD="width: 417"](Ref: 23860) 372,461JPMFAM[/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="width: 417"]
<tbody>[TR]
[TD="width: 417"](Ref: 13465) 1,546,230 UBS ASSETMANAGEMENT[/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="width: 417"]
<tbody>[TR]
[TD="width: 417"](Ref: ECE51) 370,915225 FRANKLINST[/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="width: 417"]
<tbody>[TR]
[TD="width: 417"](Ref: EQA04) 56,593BLACKROCKINVESTMENT [/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="width: 417"]
<tbody>[TR]
[TD="width: 417"](Ref: EQA15) 110,22117F 100,TOEGYE-RO
[TABLE="width: 421"]
<tbody>[TR]
[TD="width: 421"](Ref: 85789) 304,64211-3, HAMAMATSUCHO, 2-CHOME,[/TD]
[/TR]
</tbody>[/TABLE]

So here is how the rows work. First there is the ref code (red), then the shares amount (green),
then the manager or the address of the manager (orange).[/TD]
[/TR]
</tbody>[/TABLE]

From this we need the green in a cell and the orange part in a cell. (red is not needed). As you can see, the problem is that because of the bad conversion the end of the green part is not always the same. Sometimes it ends with a space, sometimes it is together and the worst is when there is an address number after it there is no space in between. I am open to all solutions., but what I thought of is this. The end of the ref code is always the same ") ". What the macro should do is it should find this point in the cell (by the way this is column D), and after that it should copy from one up to 3 numbers. If there is a comma "," after the 3rd number it should copy the 3 numbers after that and so on until there is no comma after the 3 number.

So in the end if the base text is in Cell D38 for example is [TABLE="width: 417"]
<tbody>[TR]
[TD="width: 417"](Ref: EQA15) 110,22117F 100,TOEGYE-RO[/TD]
[/TR]
</tbody>[/TABLE]
then it should have 110,221 in Cell M38 and 17F 100,TOEGYE-RO in cell N38.

I hope this is possible. I am open to all solutions because this might not work 100% of the time, so some advice would be much appreciated.

 

[CaptainCsaba]

Ok try these:

Function AddSpace(c As Range)

x = c.Value
If InStr(x, ")") > 0 Then
    x = Trim(Mid(x, InStr(x, ")") + 1))
    For i = 1 To Len(x)
        If Mid(x, i, 1) = "," Then
            If Mid(x, i + 4, 1) <> "," And Mid(x, i + 4, 1) <> " " Then
                x = Left(x, i + 3) & " " & Mid(x, i + 4, Len(x))
            End If
        End If
    Next
End If
AddSpace = x
        
End Function

Function GetNumber(c As Range)

GetNumber = Left(AddSpace(c), InStr(AddSpace(c), " ")-1)
        
End Function

Function GetAddress(c As Range)

GetAddress = Mid(AddSpace(c), InStr(AddSpace(c), " ") + 1, Len(c))
        
End Function

Put them in a standard module then use them like =GetNumber(A1) or =GetAddress(A1)

I inserted it to the end but it does not work unfortunately. Nothing appears in the M and N column from column D

 

[steve the fish]

You inserted what to the end of what? To get what i gave to work you copy it all then insert it into a blank module. Then in whatever cell you want type =GetNumber(A1) where the cell A1 contains your text to split. Likewise =GetAddress(A1).

 

[Peter_SSs]

I can also see that in some cases (if the possibility of no space between the shares and the address exists) it would be impossible to tell where the shares finish and the address starts. For example, in row 10 in my screen shot below, it could be:
Shares: 421, Address: "1-3, H...", or
Shares: 42, Address: "11-3, H...", or
Shares: 4, Address: "211-3, H..."

It is a similar situation with rows 11 & 12. Hence, my user-defined functions are unable to determine those values, but at least those rows are highlighted and the functions in the other rows might be some use.

Just to check the implementation of the UDFs ..
1. Right click the sheet name tab and choose "View Code".
2. In the Visual Basic window use the menu to Insert|Module
3. Copy and Paste the code below into the main right hand pane that opens at step 2.
4. Close the Visual Basic window.
5. Enter the formulas as shown in the screen shot below and copy down. (You can format the Shares column with a number format if you want the commas to display.)
6. Your workbook will need to be saved as a macro-enabled workbook (*.xlsm)

Function GetShares(s As String) As Variant
  Static RX As Object
  
  GetShares = "Unknown"
  If RX Is Nothing Then Set RX = CreateObject("VBScript.RegExp")
  RX.Pattern = "^(\(.+\)\D*)((\d{2}[^\d,])|(\d{3}[^,]))"
  If Not RX.Test(s) Then
    RX.Pattern = "^(\(.+\)\D*)(\d{1,3}(,\d{3})*)"
    If RX.Test(s) Then GetShares = CLng(RX.Execute(s)(0).Submatches(1))
  End If
End Function


Function GetAddress(s As String) As String
  Static RX As Object
  
  GetAddress = "Unknown"
  If RX Is Nothing Then Set RX = CreateObject("VBScript.RegExp")
  RX.Pattern = "^(\(.+\)\D*)((\d{2}[^\d,])|(\d{3}[^,]))"
  If Not RX.Test(s) Then
    RX.Pattern = "^(\(.+\)\D*)(\d{1,3}(,\d{3})*)"
    If RX.Test(s) Then GetAddress = Trim(RX.Replace(s, ""))
  End If
End Function

Excel Workbook
	D	M	N
1	Data	Shares	Address
2	(Ref: ABN97) 1,353,255 JUPITER ASSET MANAGEMENT	1353255	JUPITER ASSET MANAGEMENT
3	(Ref: 16127) 325,000NFU MUTUAL	325000	NFU MUTUAL
4	(Ref: 23860) 372,461JPMFAM	372461	JPMFAM
5	(Ref: 13465) 1,546,230 UBS ASSETMANAGEMENT	1546230	UBS ASSETMANAGEMENT
6	(Ref: ECE51) 370,915225 FRANKLINST	370915	225 FRANKLINST
7	(Ref: EQA04) 56,593BLACKROCKINVESTMENT	56593	BLACKROCKINVESTMENT
8	(Ref: EQA15) 110,22117F 100,TOEGYE-RO	110221	17F 100,TOEGYE-RO
9	(Ref: 85789) 304,64211-3, HAMAMATSUCHO, 2-CHOME,	304642	11-3, HAMAMATSUCHO, 2-CHOME,
10	(Ref: 85789) 4211-3, HAMAMATSUCHO, 2-CHOME,	Unknown	Unknown
11	(Ref: 85789) 42 HAMAMATSUCHO, 2-CHOME,	Unknown	Unknown
12	(Ref: 85789) 421 HAMAMATSUCHO, 2-CHOME,	Unknown	Unknown
Sheet1

 

[CaptainCsaba]

Thank you for the detailed reply, Peter! I am new to this and (haven't even seen "functions" yet). It works perfectly. 99.99999% of the time what you mentioned above does not happen, but when it does, what you created handles it correctly. So thanks again, you helped a group of 8 people reduce their workload with 2 hours each every week!

 

[steve the fish]

Thats what i was trying to give you as well. Would work in pretty much the same manner. Certainly worked on your example data.

 

[Peter_SSs]

Thank you for the detailed reply, Peter! I am new to this and (haven't even seen "functions" yet). It works perfectly. 99.99999% of the time what you mentioned above does not happen, but when it does, what you created handles it correctly. So thanks again, you helped a group of 8 people reduce their workload with 2 hours each every week!

You are welcome.

BTW, I agree with Steve that his functions do pretty much the same job (though I had initially thought they didn't ). Perhaps it was just the implementation detail that you needed. Anyway, it was an interesting exercise and you got a couple of options to choose from.