Get data from online with code

RAJESH1960

Banned for repeated rules violations
Joined
Mar 26, 2020
Messages
2,313
Office Version
  1. 2019
Platform
  1. Windows
Hello code experts,

What I am trying to do today is something what I have not tried and not ever heard before..

I am trying to get data into my workbook from an online site with the help of a code. I am sharing this video and the workbook in the links below. The video shows what I am trying to do exactly and the workbook contains the steps involved to do the same. I have also the expected result sheet in the workbook.
Loading Google Sheets

Video - Get Data from online site.mp4
The site to get the data from is Check GSTIN/UIN Number Format | GSTZen

EDITS:
3 Links I shared. One is the video, the other is the workbook and the 3rd one is from where I need the data

The 3rd one is a free site. Anyone can get the details of any GSTIN number provided it is correct. If it is wrong it will display a x on the right side else a tick mark stating it is correct.
 
Last edited by a moderator:

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Here is swing #1.

VBA Code:
Option Explicit

#If VBA7 Then
    Public Declare PtrSafe Function SetParent Lib "user32" (ByVal hWndChild As LongPtr, ByVal hWndNewParent As LongPtr) As LongPtr
#Else
    Private Declare Function SetParent Lib "user32.dll" ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
#End If
'

Sub Newest()
'
'--------------------------------------------------------------------------------------
'
' Step 1
'
    Dim ColumnFirstNonGreenRow  As Long
    Dim FormulaCount            As Long
    Dim LastRow                 As Long, LastRowDownloadedSheet As Long
    Dim SecondsToDelay          As Long
    Dim Browser                 As Object
    Dim CurrentTime             As Single, DelayStartTime       As Single
    Dim DownloadedSheetName     As String, DownloadedWorkbook   As String
    Dim DSCol                   As String                                                   ' DestinationSortColumn
    Dim RenamedMismatchesSheet  As String
    Dim strData                 As String, WebSite              As String
    Dim WB                      As Workbook
    Dim WS                      As Worksheet
'
    Set WS = ThisWorkbook.Sheets("Mismatches")                                              ' <--- Set this to the sheet to sort
    RenamedMismatchesSheet = "xyz"                                                          ' <--- Set this to the name of the renamed 'Mismatches' sheet
    WebSite = "https://my.gstzen.in/p/gstin-validator/"                                     ' <--- Set this to the website that you want to go to
'
    DSCol = "B"
    LastRow = WS.Range("B" & Rows.Count).End(xlUp).Row                                      ' Get last row used in Column B of 'Mismatches' sheet
'
    WS.Sort.SortFields.Clear                                                                ' Clear the sort fields
'
    With WS
        .Range("A2:O" & LastRow).Sort _
            Key1:=.Range("G2"), Order1:=xlAscending, _
            Key2:=.Range("H2"), Order2:=xlAscending, _
            Key3:=.Range("B2"), Order3:=xlAscending, Header:=xlNo                           '       Sort the Mismatches sheet by various columns
    End With
'
'--------------------------------------------------------------------------------------
'
' Step 2
'
    Application.DisplayAlerts = False                                                       ' Turn DisplayAlerts off
    WS.Copy After:=Sheets(Sheets.Count)                                                     ' Copy 'Mismatches' sheet to end of workbook
    Application.DisplayAlerts = True                                                        ' Turn DisplayAlerts back on
    ActiveSheet.Name = RenamedMismatchesSheet                                               ' Name the copy of the 'Mismatches' sheet
'
'--------------------------------------------------------------------------------------
'
' Step 3
'
    With Sheets(RenamedMismatchesSheet)
        .Sort.SortFields.Clear                                                              '   Clear the sort fields
        .Range("A2:O" & LastRow).Sort Key1:=.Range("B2"), Order1:=xlAscending, Header:=xlNo '   Sort the Mismatches copied sheet by 'As Per' column
'
'--------------------------------------------------------------------------------------
'
' Step 4
'
        .Range(Columns("P"), Columns(Columns.Count)).ClearFormats                           '   Clear formatting from Columns P to end of sheet
    End With
'
'--------------------------------------------------------------------------------------
'
' Step 5 https://my.gstzen.in/p/gstin-validator/
'
    With Sheets(RenamedMismatchesSheet)
        ColumnFirstNonGreenRow = .Range(DSCol & "1:" & DSCol & .Range("A" & _
                Rows.Count).End(xlUp).Row).Find(what:="TALLY", LookAt:=xlWhole, _
                SearchDirection:=xlNext).Row                                        ' Locate first row in column with value of 'TALLY'
'
        .Range("C2:C" & ColumnFirstNonGreenRow - 1).Copy                            ' Copy data from 'XYZ' sheet to clipboard
    End With
'
    strData = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("Text")   ' Save contents from clipboard into strData
'
    Set Browser = CreateObject("InternetExplorer.Application")
'
    With Browser
        .Visible = True                                                             '   Set IE window status to visible
        SetParent .Hwnd, Application.Hwnd
        .navigate WebSite                                                           '   Go to the website
'
        Do While .Busy Or .ReadyState <> 4                                          '   Loop to wait for website to fully load
            DoEvents
        Loop
'
        .document.getElementsByTagName("textarea")(0).innertext = strData           '   Copy data to text box on website
'
        .document.querySelector("button[type=submit]").Click                        '   Click the 'Check GSTIN/UIN Numbers' button
'
        SecondsToDelay = 3                                                          '   We will delay for some seconds to allow next page start loading
'
        DelayStartTime = Timer                                                      '   Save the starting time of the delay
'
        Do                                                                          '   Loop to delay
            CurrentTime = Timer                                                     '       Save current time into CurrentTime
            If CurrentTime < DelayStartTime Then CurrentTime = CurrentTime + 86400  '       If time has crossed over midnight, adjust CurrentTime
'
            DoEvents
        Loop Until CurrentTime - DelayStartTime >= SecondsToDelay                   '   Loop back if delay has not finished
'
        Do While .Busy Or .ReadyState <> 4                                          '   Loop to wait for website to fully load
            DoEvents
        Loop
'
        Set WB = Workbooks.Open(.document.querySelector("[class='pull-right btn btn-sm btn-excel']"))   ' Open the download link into workbook
'
        .Quit                                                                       '   Close the browser
    End With
'
    DownloadedWorkbook = ActiveWorkbook.Name                                        ' Save name of downloaded file to DownloadedWorkbook
    ActiveSheet.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)          ' Copy the sheet from downloaded file to ThisWorkbook
'
    Workbooks(DownloadedWorkbook).Close SaveChanges:=False                          ' Close the downloaded file
'
    Set Browser = Nothing                                                           ' Clear browser from memory
'
'--------------------------------------------------------------------------------------
'
' Step 6
'
    DownloadedSheetName = ActiveSheet.Name                                          ' Save the downloaded sheet name to DownloadedSheetName
'
    With Sheets(RenamedMismatchesSheet)
        Sheets(DownloadedSheetName).Range("A1:L1").Copy .Range("P1:AA1")            ' Copy Header row from the downloaded sheet to RenamedMismatchesSheet
'
        LastRowDownloadedSheet = Sheets(DownloadedSheetName).Range("A" & _
                Sheets(DownloadedSheetName).Rows.Count).End(xlUp).Row               '   Get last row used in the DownloadedSheet
'
        For FormulaCount = 1 To 12                                                  '   Loop to write formulas across range
            .Cells(2, 15 + FormulaCount).Formula = _
                    "=VLOOKUP(C2,'" & DownloadedSheetName & "'!$A$2:$L$" & _
                    LastRowDownloadedSheet & "," & FormulaCount & ",0)"             '       Write formula to cell
        Next                                                                        '   Loop back
'
        .Range("P2:AA2").AutoFill Destination:=.Range("P2:AA" & ColumnFirstNonGreenRow - 1) '   Fill the formulas down the range

        .Range("P2:AA" & ColumnFirstNonGreenRow - 1).Copy                           '   Copy formula range into memory (Clipboard)
        .Range("P2:AA" & ColumnFirstNonGreenRow - 1).PasteSpecial xlPasteValues     '   Paste just the values back to range
'
        Application.CutCopyMode = False                                             '   Clear clipboard & 'marching ants' around copied range
'
        .Range("Q2:Q" & ColumnFirstNonGreenRow - 1).NumberFormat = "dd-mm-yyyy"      '   Format Dates in Column Q

        .UsedRange.EntireColumn.AutoFit                                             '   Autofit all of the columns on the destination Sheet
    End With
'
    MsgBox "Completed"                                                              ' Let user know the program has completed
End Sub
 
Upvote 0
Solution
As expected. The swing sent the ball out of the play ground.
I have to replace xyz only once I decide to name the sheet right.
Rich (BB code):
RenamedMismatchesSheet = "xyz"
 
Upvote 0
Is it possible to delete the mismatches (2) sheet.? It is an extra copy I assume.
 
Upvote 0
Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Get data from web to my worksheet with the help of a code. [SOLVED]
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.
 
Upvote 0
Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Get data from web to my worksheet with the help of a code. [SOLVED]
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.
Sorry Fluff. I did the same in the other forum but I forgot to mention it here. I had posted it here first. I will make sure that I mention that next time.
 
Upvote 0
Is it possible to delete the mismatches (2) sheet.? It is an extra copy I assume.
I ran the code twice so got an extra copy of the mismatches sheet with an error. My bad. The code is perfect.
Thanks JohnnyL.
 
Upvote 0
I have to replace xyz only once I decide to name the sheet right.
Rich (BB code):
RenamedMismatchesSheet = "xyz"
That is correct. I try to make my code easy to update.

Any issues that need to be resolved?
 
Upvote 0
That is correct. I try to make my code easy to update.

Any issues that need to be resolved?
None for now. I have to add this code to the already existing code. If I am not able to then I will post a new thread.
Thank you man. Good Night.
 
Upvote 0

Forum statistics

Threads
1,215,460
Messages
6,124,949
Members
449,198
Latest member
MhammadishaqKhan

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top