Need help to improve my VBA code

[smide]

Hello.

I'm using the following code to parse my raw report from row1-Sheet5 and transfer data to Sheet4, creating this table:

	O	P	Q	R
1
2	id	shop	store	factory
3	3456	23	15	25
4	3467	12	16	28
5	3468	24	19	33
6	....	....	....	....

<tbody>
</tbody>

Data in row1-Sheet5 are organized in the following pattern: id - shop - store - factory

My problem is reflected in the fact that sometimes between the two id's there are no this "shop-store-factory" cells which means that my prices are often in the wrong row in above table (next to the wrong id).

I would like to re-arrange this code so in the case that between the two id's there are no this cells which contains significant text (shop-store-factory), then, in the table, that row stays empty.

example:

(id-shop-store-factory) (id-shop-store-factory) (id) (id-shop-store-factory) (id-shop-store-factory) ....

	O	P	Q	R
1
2	id	shop	store	factory
3	3456	23	15	25
4	3467	12	16	28
5	3468
6	3470	24	19	33
7	3471	27	11	39

<tbody>
</tbody>

Here is the code I used so far:

Sub Salary()

[B]' extract id's from row 1 Sheet5
[/B]
Dim C As Long, X As Long, Data As Variant, Result As Variant
  Data = Sheets("Sheet5").Range("A1", Sheets("Sheet5").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("Sheet4").Range("O3").Resize(UBound(Result)) = Result


[B]'extract shop-store-factory prices from row 1 Sheet5
[/B]
Dim a As Variant, b As Variant
  Dim i As Long, k As Long, pos As Long
  
  With Sheets("Sheet5")
    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 And IsNumeric(Mid(a(1, i), pos + 8)) 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("Sheet4").Range("P3:R3").Resize(k).Value = b
  End If

End Sub

 

[oldbrewer]

your new table is the same as the original table ie first 2 rows are identical

 

[smide]

your new table is the same as the original table ie first 2 rows are identical

Yes, but the whole point is in row five (or row three if you exclude first two) which is empty because there is no this shop-store-factory cells between two id's (between 3rd and 4th id).
Of course the 3rd id is equal to 3468 ie the contents of that cell is: {"id":3468

 

[oldbrewer]

if your data was this
id1	88
id2
id3	66
id4
id5	44
is your desired output
id1	88
id3	66
id5	44

<colgroup><col span="2"></colgroup><tbody>
</tbody>