smide
Board Regular
- Joined
- Dec 20, 2015
- Messages
- 162
- Office Version
- 2016
- Platform
- Windows
Hello.
I'm using the following code to parse my raw report from row1-Sheet5 and transfer data to Sheet4, creating this table:
<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) ....
<tbody>
</tbody>Here is the code I used so far:
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>
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>
Code:
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
Last edited: