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