VBA to extract only number 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).

In row1 in Sheet2 I have a raw report output which contains certain Products id's.
The problem is that I need to find cells that contain this data about product's id's, then to extract only id numbers from those cells without unnecessary characters in those cells.

There are four type of cells which contain product's id characteristics (all cells are in row 1, Sheet2 as I said):

Example:

1) events:[{"id":45 - I need only number 45 from this cell

2) {"id":626702572 - I need only number 626702572

but there are also "dummy" cells with similar "id" characteristics:

3) account:[{"id":2370

or

4) annual:[{"id":3460

I do not need id from these cells !! (from 3) and/or 4) )

Extended example

Sheet2 (raw report)

	A	B	C	D	E	F	G	H	I	J
1	events:[{"id":	status:"I"	events:[{"id":7650	starts:	maxTotal:50	{"id":976	account:[{"id":2370	cutoff:	{"id":45700	...

<tbody>
</tbody>

* deliberately I skipped id from G1(!) cell because I do not need id with this characteristics (case 3) )

Sheet1 (after macro or formula run)

	A	B
1
2	7650
3	976
4	45700
5	.....

<tbody>
</tbody>

 

[Rick Rothstein]

See if this macro does what you want...

Sub GetIDs()
  Dim C As Long, X As Long, Data As Variant, Result As Variant
  Data = Range("A1", Cells(1, Columns.Count).End(xlToLeft))
  ReDim Result(1 To UBound(Data, 2), 1 To 1)
  For C = 1 To UBound(Data, 2)
    If Data(1, C) Like "*""[Ii][Dd]"":#*" And _
       Left(LCase(Data(1, C)), 14) <> "annual:[{""id"":" And _
       Left(LCase(Data(1, C)), 15) <> "account:[{""id"":" Then
      X = X + 1
      Result(X, 1) = Mid(Data(1, C), InStrRev(Data(1, C), ":") + 1)
    End If
  Next
  Range("A2").Resize(UBound(Result)) = Result
End Sub

 

[smide]

Thank you for reply.
Unfortunately there is a some problem with code:
Run-time error '13':
Type mismatch

Some problem in (After debug):
ReDim Result(1 To UBound(Data, 2), 1 To 1)

 

[Rick Rothstein]

Thank you for reply.
Unfortunately there is a some problem with code:
Run-time error '13':
Type mismatch

Some problem in (After debug):
ReDim Result(1 To UBound(Data, 2), 1 To 1)

Was Sheet2 active when you ran my code? If no, try it again after making Sheet2 active... if yes, then is your data really on Row 1?

 

[smide]

Was Sheet2 active when you ran my code? If no, try it again after making Sheet2 active... if yes, then is your data really on Row 1?

I see now...
I run code (again) from Sheet2 (active sheet) and results were in column A in Sheet2, but Sheet1 was still empty...
How can I transfer results in Sheet1 (column A) directly ?
Basically I want to run code from Sheet1 and to get results also in Sheet1...

 

[Rick Rothstein]

Basically I want to run code from Sheet1 and to get results also in Sheet1...

I have modified my code so you can run it from any sheet...

[table="width: 500"]
[tr]
	[td]Sub GetIDs()
  Dim C As Long, X As Long, Data As Variant, Result As Variant
  Data = Sheets("Sheet2").Range("A1", Sheets("Sheet2").Cells(1, Columns.Count).End(xlToLeft))
  ReDim Result(1 To UBound(Data, 2), 1 To 1)
  For C = 1 To UBound(Data, 2)
    If Data(1, C) Like "*""[Ii][Dd]"":#*" And _
       Left(LCase(Data(1, C)), 14) <> "annual:[{""id"":" And _
       Left(LCase(Data(1, C)), 15) <> "account:[{""id"":" Then
      X = X + 1
      Result(X, 1) = Mid(Data(1, C), InStrRev(Data(1, C), ":") + 1)
    End If
  Next
  Sheets("Sheet1").Range("A2").Resize(UBound(Result)) = Result
End Sub[/td]
[/tr]
[/table]

 

[smide]

I have modified my code so you can run it from any sheet...

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub GetIDs()
  Dim C As Long, X As Long, Data As Variant, Result As Variant
  Data = Sheets("Sheet2").Range("A1", Sheets("Sheet2").Cells(1, Columns.Count).End(xlToLeft))
  ReDim Result(1 To UBound(Data, 2), 1 To 1)
  For C = 1 To UBound(Data, 2)
    If Data(1, C) Like "*""[Ii][Dd]"":#*" And _
       Left(LCase(Data(1, C)), 14) <> "annual:[{""id"":" And _
       Left(LCase(Data(1, C)), 15) <> "account:[{""id"":" Then
      X = X + 1
      Result(X, 1) = Mid(Data(1, C), InStrRev(Data(1, C), ":") + 1)
    End If
  Next
  Sheets("Sheet1").Range("A2").Resize(UBound(Result)) = Result
End Sub[/TD]
[/TR]
</tbody>[/TABLE]

Exactly what I was looking for, thank you so much.