Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

Adding a Condition to match the ID with JSON

0

I am trying to create a two conditions in Col"B" and Col"L" if matches then take the ID Number from Col"P" and get the result in JSON.

JSON appear like this:

{"id":16,"sku":"4926","productName":"Diforda","upc":"test",
"condition":"test","uniqueID":1234,"logsCey":3,
"Processing":true,"addedDateTime":"2021-06-22T04:07:35.15",
"softDelete":false,"newLogno":776655}

After that code will find in JSON where Processing = True then take the newLogno from JSON and paste that in Col"A" against same Row if it is False then repeat the same process for 2nd ID Number from Col"P".

If someone can please share a solution i would really appreciate.

Sub Testing()
Dim objRequest As Object
Dim strUrl As String
Dim blnAsync As Boolean
Dim strResponse As String
Dim idno As Variant
Dim ws As Worksheet
Set ws = Sheet4
LRow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
For r = LRow To 2 Step -1
idno = ws.Cells(r, "P").Value
If ws.Cells(r, "B") <> "" And ws.Cells(r, "L") = "Tenu" Then
Set objRequest = CreateObject("MSXML2.XMLHTTP")
strUrl = "URL" & idno
End If
blnAsync = True
With objRequest
.Open "GET", strUrl, blnAsync
.setRequestHeader "Content-Type", "application/json"
.send
While objRequest.readyState <> 4
DoEvents
Wend
strResponse = .ResponseText
End With
Next
strResponse = ws.Cells(r, "A")
End Sub
Answer
Discuss

Discussion

Hi and welcome to the Forum

It's too late for me to reply but please edit your original question to add a representative Excel file (using the Add Files.. button). That will help contributors to reply. 
John_Ru (rep: 6152) Jun 28, '21 at 5:26 pm
I have edited the question please look into it thanks.
ExcelBegginer (rep: 4) Jun 29, '21 at 3:29 am
Add to Discussion

Answers

0
Selected Answer

Shoaib

I haven't done JSON queries but assuming you have the correct libraries installed, please try this code in the attached, revised file. I've put lines/comments in bold below to show what I've done (e,g, correcting your statement setting ws to an non-existent Sheet4):

Sub Testing()

Dim objRequest As Object
Dim strUrl As String
Dim blnAsync As Boolean
Dim strResponse As String
Dim idno As Variant
Dim ws As Worksheet

Set ws = Sheet1 ' ### corrected this
blnAsync = True 'Added this
LRow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row

For r = LRow To 2 Step -1

    idno = ws.Cells(r, "P").Value
    If ws.Cells(r, "B") <> "" And ws.Cells(r, "L") = "Tenu" Then
        Set objRequest = CreateObject("MSXML2.XMLHTTP")
        strUrl = "URL" & idno

        With objRequest
            .Open "GET", strUrl, blnAsync 'Think you need this
            .setRequestHeader "Content-Type", "application/json"
            .send

            While objRequest.readyState <> 4
            DoEvents
            Wend

            strResponse = .ResponseText
        End With

        ws.Cells(r, "A") = strResponse ' ### moved and changed this

        Else ' added this
        ws.Cells(r, "A") = ""

    End If ' ### moved this

Next

End Sub
Please test and let me know if this works for you.
Discuss

Discussion

Thank you very muhc it is excatly what i have been looking for.
ExcelBegginer (rep: 4) Jun 29, '21 at 9:29 am
Great! Thanks for selecting my Answer Shoaib
John_Ru (rep: 6152) Jun 29, '21 at 10:40 am
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login