VBA Script to extract two sets of numbers between text in cell

[johnbrownbaby]

Hello,

Thanks to the elegant solution to the first question posted here, I was able to get a formula based solution. I am finding that if the data is given like this:

I am having a problem keeping up with the formula based approach. How can I do this from VB script viewpoint to collect the data from column A where all the "eFine" and "eFood" numbers are placed in separate columns found in K and L respectively?

I posted a preliminary question on OzGrid found here but I do not know how to delete that question to make this updated question priority.

test1.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1											Test 1	Amp
2											2404852	12827
3											2404892	12855
4											2404860	12914
5											2404589	13015
6
7	Pack: AMPLITUDE_ACCESS
8	eFine: 2404852 eFood: 12827
9
10
11
12
13
14	Pack: AMPLITUDE_ACCESS
15	eFine: 2404892 eFood: 12855
16
17
18
19
20
21	Pack: AMPLITUDE_ACCESS
22	eFine: 2404860 eFood: 12914
23
24
25
26
27
28	Pack: AMPLITUDE_ACCESS
29	eFine: 2404589 eFood: 12015
30
31	***
32	*** DISCONNECT
33	*** time 14:38:02
34	***
35
36
37	[INFO] INFO: DISCONNECTED
38
39
40	Pack: AMPLITUDE_ACCESS
41	eFine: 2404892 eFood: 12855
42
43
44
45
46
47	Pack: AMPLITUDE_ACCESS
48	eFine: 2404860 eFood: 12914
49
50
51
52
53
54	Pack: AMPLITUDE_ACCESS
55	eFine: 2404589 eFood: 12015
56
57	***
58	*** DISCONNECT
59	*** time 14:38:02
60	***
61
62
63	[INFO] INFO: DISCONNECTED
Sheet1

Thanks for your help and time!

 

[johnbrownbaby]

In your example you only have 4 results, I assumed that you only wanted the unique values. But if you want all, on all sheets, try the following. The results will be on the first sheet.

Sub extract_two_sets_of_numbers2()
  Dim r As Range, f As Range
  Dim cell As String
  Dim arr As Variant
  Dim sh As Worksheet
 
  For Each sh In Sheets
    Set r = sh.Range("A1", sh.Range("A" & Rows.Count).End(3))
    Set f = r.Find("eFine", , xlValues, xlPart, , , False)
    If Not f Is Nothing Then
      cell = f.Address
      Do
        arr = Split(f.Value, " ")
        Sheets(1).Range("K" & Rows.Count).End(3)(2).Resize(, 2).Value = Array(arr(1), arr(3))
        Set f = r.FindNext(f)
      Loop While Not f Is Nothing And f.Address <> cell
    End If
  Next
End Sub

THANK YOU!

 

[DanteAmor]

THANK YOU!

You are welcome.
Glad I was able to help!