Extract only part of text from a cells in Excel report

[smide]

Hello.
I need some assistance with an excel spreadsheet which contains very raw output report in row 1 columns (A-ZW).
I'm not very proficient with excel-vba but I'm open to suggestions and willing to learn to get this to work properly.

As I already stated in row1 in Sheet2 I have a raw report output which contains certain Product prices.
Each product is presented with three prices: shop, factory and market.
The problem is that I need to find cells that contain this data about product's prices, then to extract only numbers (prices) from those cells without unnecessary characters in those cells.

The cells which contain product's characteristics (all cells are in row 1,Sheet2 as I said) always follow the next pattern:

Example.

Sheet2

cell (1,D) product:{"shop":15.80
cell (1,E) factory:10.40
cell (1,F) market:14.20}

(cells with this characteristics/special characters/brackets are always consecutive cells in row 1 (Sheet2))

I need this price data formated as some sort of data frame/table starting from cell B2 in Sheet1 in following format:

Sheet1

cell (2,B) 15.80
Cell (2,C) 10.40
cell (2,D) 14.20

Extended example

Sheet2 (raw report)

A

B

C

D

E

F

G

H

I

J

K

L

M

1

events:[{"id":

status:"I"

Restriction:2}

product:{"shop":15.80

factory:10.40

market:14.20}

starts:

maxTotal:50

product:{"shop":30.95

factory:21.77

market:28.45}

cutoff:"

...

2

<tbody>
</tbody>

Sheet1 (after macro or formula run)

	A	B	C	D
1
2		15.80	10.40	14.20
3		30.95	21.77	28.45
4		....	....	....
5

<tbody>
</tbody>

 

[Peter_SSs]

Try this in a copy of your workbook.

Sub Get_Prices()
  Dim a As Variant, b As Variant
  Dim i As Long, k As Long, pos As Long
  
  With Sheets("Sheet2")
    a = .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft)).Value
  End With
  ReDim b(1 To UBound(a, 2), 1 To 3)
  For i = 1 To UBound(a, 2) - 2
    pos = InStr(1, a(1, i), "{""shop"":", vbTextCompare)
    If pos > 0 Then
      k = k + 1
      b(k, 1) = Val(Mid(a(1, i), pos + 8))
      b(k, 2) = Val(Mid(a(1, i + 1), InStr(1, a(1, i + 1), ":") + 1))
      b(k, 3) = Val(Mid(a(1, i + 2), InStr(1, a(1, i + 2), ":") + 1))
    End If
  Next i
  If k > 0 Then
    Sheets("Sheet1").Range("B2:D2").Resize(k).Value = b
  End If
End Sub

 

[smide]

Thank you so much Peter. :wink:
Can I just ask you: in some cells periodically (also in row 1 of course) I have following text: storTotal:{"shop":{"totals":75
Basically I'm not interested about those prices(price in that and two following cells)and it does not bother me too much just in output I always have an one extra row (actually row number doubled in output because of this extra characters).
Do you have any idea how to fix this?

 

[Peter_SSs]

Try adding the blue text to the line indicated

If pos > 0 And IsNumeric(Mid(a(1, i), pos + 8)) Then

 

[smide]

Yes, problem solved!
Thank you for your prompt reply.[h=2][/h]

 

[Peter_SSs]

Yes, problem solved!
Thank you for your prompt reply.[h=2][/h]

You are welcome. Glad it was what you wanted.