Option Explicit
'
#If VBA7 Then
' Timer settings for 64Bit Excel
Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias _
"QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias _
"QueryPerformanceCounter" (cyTickCount As Currency) As Long
#Else
' Timer settings for 32Bit Excel
Private Declare Function getFrequency Lib "kernel32" Alias _
"QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function getTickCount Lib "kernel32" Alias _
"QueryPerformanceCounter" (cyTickCount As Currency) As Long
#End If
'
Sub GetDataFromWeb()
'
Dim StartTime As Double
StartTime = MicroTimer ' Start the stopwatch
'
Dim ArrayRow As Long
Dim CheckCount As Long
Dim FormulaCount As Long, GSTIN_Count As Long, GSTINsToCheck As Long
Dim LastRowThisWorkbook As Long
Dim NA_EndRow As Long, NA_StartRow As Long
Dim LastRow As Long, LastRowDownloadedSheet As Long, LastRowRenamedSheet As Long
Dim RowCount As Long, EndRow As Long, StartRow As Long
Dim WebProcessedGSTINs As Long
Dim Browser As Object
Dim Dict As Object
Dim TextWindow As Object
Dim cel As Range
Dim rng As Range, rngFound As Range
Dim CopiedData As String
Dim DownloadedSheetName As String
Dim MainColumn As String
Dim RenamedPurchasesSheet As String
Dim WebSite As String
Dim GSTIN_Array As Variant
Dim IncorrectGSTIN_Array As Variant
Dim DownloadedWorkbook As Workbook
Dim WB As Workbook
Dim DSN As Worksheet
Dim WS As Worksheet
'
Set WS = ThisWorkbook.Sheets("Purchases") ' <--- Set this to the sheet to sort
RenamedPurchasesSheet = "GSTIN verification" ' <--- Set this to the name of the renamed 'Purchases' sheet
'
MainColumn = "B" ' <--- Set this to the column to be used for last row
'
WebSite = "https://my.gstzen.in/p/gstin-validator/" ' <--- Set this to the website that you want to go to
'
'-------------------------------------------------------------------------------------------
'
'
With WS
LastRow = .Range(MainColumn & .Rows.Count).End(xlUp).Row ' Get last row used in Column B of 'Purchases' sheet
'
If .Range(MainColumn & "2") = vbNullString Then ' If B2 in Purchases sheet is blank then ...
MsgBox "Enter GSTIN Number in column B." ' Display message to user
Exit Sub ' Exit the code
End If
'
.UsedRange.Interior.Pattern = xlNone ' Clear the green filled cell in the used range of 'Purchases' sheet
.Range(Columns("K"), .Columns(Columns.Count)).ClearFormats ' Clear formatting from Columns K to end of 'Purchases' sheet
'
.Range("A2").Formula = "=Row()-1" ' Write formula to cell
.Range("A2").AutoFill Destination:=.Range("A2:A" & LastRow) ' Fill the formulas down the range
.Range("A2:A" & LastRow).Copy ' Copy formula range into memory (Clipboard)
.Range("A2:A" & LastRow).PasteSpecial xlPasteValues ' Paste just the values back to range
Application.CutCopyMode = False ' Clear clipboard & 'marching ants' around copied range
'
Application.CopyObjectsWithCells = False ' Don't copy the Macro button in the following copy
.Copy after:=Sheets(Sheets.Count) ' Copy 'Purchases' sheet to end of workbook
'
ActiveSheet.Name = RenamedPurchasesSheet ' Name the copy of the 'Purchases' sheet
End With
'
'--------------------------------------------------------------------------------------
'
'
Set Dict = CreateObject("Scripting.Dictionary")
'
With Sheets(RenamedPurchasesSheet)
LastRowRenamedSheet = .Range(MainColumn & .Rows.Count).End(xlUp).Row ' Get last used row # of column B on RenamedPurchasesSheet
'
GSTIN_Array = .Range(MainColumn & "2:" & MainColumn & LastRowRenamedSheet) ' Save GSTIN #s into GSTIN_Array
'
For ArrayRow = 1 To UBound(GSTIN_Array, 1) ' Loop through GSTIN_Array
Dict(GSTIN_Array(ArrayRow, 1)) = 1 ' Save GSTIN #
Next ' Loop back
'
.Range("A2:" & MainColumn & LastRowRenamedSheet).ClearContents ' Clear Columns A & B on the RenamedPurchasesSheet
.Range(MainColumn & "2").Resize(Dict.Count) = Application.Transpose(Dict.Keys) ' Write the unique GSTIN #s back to column B
'
LastRowRenamedSheet = .Range(MainColumn & .Rows.Count).End(xlUp).Row ' Recalculate last used row # of column B on RenamedPurchasesSheet
'
.Sort.SortFields.Clear ' Clear the sort fields
.Range("A2:J" & LastRowRenamedSheet).Sort Key1:=.Range(MainColumn & "2"), _
Order1:=xlAscending, Header:=xlNo ' Sort the RenamedPurchasesSheet by 'GSTIN' column
'
.Range("A2").Formula = "=Row()-1" ' Write GSTIN Counting formula to cell
.Range("A2").AutoFill Destination:=.Range("A2:A" & Dict.Count + 1) ' Fill the formulas down the range
.Range("A2:A" & Dict.Count + 1).Copy ' Copy formula range into memory (Clipboard)
.Range("A2:A" & Dict.Count + 1).PasteSpecial xlPasteValues ' Paste just the values back to range
Application.CutCopyMode = False ' Clear clipboard & 'marching ants' around copied range
'
End With
'
'--------------------------------------------------------------------------------------
'
' Step 5
'
'
Set Browser = CreateObject("InternetExplorer.Application")
'
GSTIN_Count = LastRowRenamedSheet - 1 ' Number of GSTIN's remaining to be checked
GSTINsToCheck = 450 ' Number of GSTINs we will process if > 500 remaining
EndRow = 1 ' Initialize EndRow
'
Do While GSTIN_Count > 0 ' Loop until all GSTINs have been checked
StartRow = EndRow + 1 ' Set the StartRow #
'
If GSTIN_Count > 500 Then ' If GSTIN_Count > amount that can be processed @ 1 time then ...
GSTIN_Count = GSTIN_Count - GSTINsToCheck ' Subtract from Total amount remaining
EndRow = StartRow + GSTINsToCheck - 1 ' Calculate end row # to copy
Sheets(RenamedPurchasesSheet).Range(MainColumn & StartRow & ":" & MainColumn & _
EndRow).Copy ' Copy data from renamed sheet to clipboard
Else ' Else ...
GSTINsToCheck = GSTIN_Count ' Set GSTINsToCheck = GSTINs remaining to be checked
GSTIN_Count = 0 ' Set GSTIN_Count = 0 to stop looping after this loop
EndRow = StartRow + GSTINsToCheck - 1 ' Calculate end row # to copy
Sheets(RenamedPurchasesSheet).Range(MainColumn & StartRow & ":" & MainColumn & _
EndRow).Copy ' Copy data from renamed sheet to clipboard
End If
'
CopiedData = CreateObject("htmlfile").parentWindow.clipboardData.GetData("Text") ' Save contents from clipboard into CopiedData
'
With Browser
.Visible = False ' Set IE window status to Invisible
.Navigate WebSite ' Go to the website
'
Do While .Busy Or .ReadyState <> 4 ' Loop to wait for website to fully load
DoEvents ' Process any pending events
Loop ' Loop back
'
On Error Resume Next ' If error occurs, ignore it, proceed to next line of code
For CheckCount = 1 To 100 ' Loop to check if TextWindow has appeared
Set TextWindow = .document.getElementsByClassName("cz-no-double-click") ' Check to see if TextWindow has appeared
If Not TextWindow Is Nothing Then Exit For ' If TextWindow has appeared then Exit this loop
Next ' Loop back
On Error GoTo 0 ' Return Error handling back to Excel
'
.document.getElementsByTagName("textarea")(0).innerText = CopiedData ' Copy CopiedData to text box on website
.document.querySelector("button[type=submit]").Click ' Click the 'Check GSTIN/UIN Numbers' button on website
'
Do While .Busy Or .ReadyState <> 4 ' Loop to wait for website to fully load
DoEvents ' Process any pending events
Loop ' Loop back
'
On Error Resume Next ' If error occurs, ignore it, proceed to next line of code
For CheckCount = 1 To 100 ' Loop to check all GSTIN#s have been processed by website
WebProcessedGSTINs = .document.getElementsByTagName("table")(0).getElementsByTagName("TR").Length ' Save # of processed
' ' GSTIN #s into WebProcessedGSTINs
If WebProcessedGSTINs > GSTINsToCheck Then Exit For ' If website has processed submitted GSTIN #s then Exit For loop
Next ' Loop back
On Error GoTo 0 ' Return Error handling back to Excel
'
' See if we can improve this \/ \/ So it doesn't occasionally give error about 'null'
Set WB = Workbooks.Open(.document.querySelector("[class='pull-right btn btn-sm btn-excel']")) ' Open the download link into workbook
End With
'
Set DownloadedWorkbook = ActiveWorkbook ' Save name of downloaded file to DownloadedWorkbook
DownloadedSheetName = ActiveSheet.Name ' Save the downloaded sheet name to DownloadedSheetName
'
On Error Resume Next ' If error occurs, ignore it, proceed to next line of code
Set DSN = ThisWorkbook.Sheets(DownloadedSheetName) ' See if downloaded sheet name already created in
' ' ThisWorkbook, if error then sheet doesn't exist
On Error GoTo 0 ' Return Error handling back to Excel
'
If Not DSN Is Nothing Then ' If DSN was successfully set (Sheet already exists) then ...
LastRowDownloadedSheet = Range("A" & Rows.Count).End(xlUp).Row ' Get last used row of the DownloadedSheet
LastRowThisWorkbook = ThisWorkbook.Sheets(DownloadedSheetName).Range("A" & _
Rows.Count).End(xlUp).Row '
'
ActiveWorkbook.Sheets(DownloadedSheetName).Range("A2:L" & LastRowDownloadedSheet).Copy _
ThisWorkbook.Sheets(DownloadedSheetName).Range("A" & LastRowThisWorkbook + 1) ' Copy results from DownloadedSheet to memory (clipboard)
'
Else ' Else ...
ActiveSheet.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) ' Copy the sheet from downloaded file to ThisWorkbook
'
ActiveSheet.Name = DownloadedSheetName ' Name the copy of sheet to DownloadedSheetName
End If
'
DownloadedWorkbook.Close SaveChanges:=False ' Close the downloaded file
Loop ' Loop back
'
Browser.Quit ' Close the browser
'
'--------------------------------------------------------------------------------------
'
' Step 6
'
With Sheets(RenamedPurchasesSheet)
Sheets(DownloadedSheetName).Range("A1:L1").Copy .Range("K1:V1") ' Copy Header row from the downloaded sheet to RenamedPurchasesSheet
'
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, 10 + FormulaCount).Formula = _
"=VLOOKUP(B2,'" & DownloadedSheetName & "'!$A$2:$L$" & _
LastRowDownloadedSheet & "," & FormulaCount & ",0)" ' Write formula to cell
Next ' Loop back
'
.Range("K2:V2").AutoFill Destination:=.Range("K2:V" & LastRowRenamedSheet) ' Fill the formulas down the range
.Range("K2:V" & LastRowRenamedSheet).Copy ' Copy formula range into memory (Clipboard)
.Range("K2:V" & LastRowRenamedSheet).PasteSpecial xlPasteValues ' Paste just the values back to range
'
Application.CutCopyMode = False ' Clear clipboard & 'marching ants' around copied range
'
.Range("L2:L" & LastRowRenamedSheet).NumberFormat = "dd-mm-yyyy" ' Format Dates in Column L
.UsedRange.EntireColumn.AutoFit ' Autofit all of the columns on the destination Sheet
End With
'
Set rng = Sheets(RenamedPurchasesSheet).Range("K2:K" & LastRowRenamedSheet) ' Set column K as the column to check for '#N/A"
'
Set rngFound = rng.Find("#N/A") ' Save if '#N/A' is found in the column
'
If rngFound Is Nothing Then ' If '#N/A' was not found in the column then ...
MsgBox "All GSTIN Numbers Matched." ' Notify user that everything matched
GoTo WrapUp ' Display time elapsed and exit
Else ' Else ...
With Sheets(RenamedPurchasesSheet)
.Sort.SortFields.Clear ' Clear the sort fields
.Range("A2:V" & LastRowRenamedSheet).Sort Key1:=.Range("K" & "2"), _
Order1:=xlAscending, Header:=xlNo ' Sort RenamedPurchasesSheet by column K
'
NA_StartRow = .Range("K:K").Find(what:="#N/A", after:=.Range("K" & _
LastRowRenamedSheet)).Row ' Find the start row of '#N/A' values
NA_EndRow = .Range("K:K").Find(what:="#N/A", after:=.Range("K1"), _
searchdirection:=xlPrevious).Row ' Find the end row of '#N/A' values
'
If NA_StartRow <> NA_EndRow Then ' If more than one '#N/A' is found then ...
IncorrectGSTIN_Array = .Range(MainColumn & NA_StartRow & ":" & _
MainColumn & NA_EndRow) ' Save Incorrect GSTIN #s into IncorrectGSTIN_Array
Else ' Else ...
IncorrectGSTIN_Array = .Range(MainColumn & NA_StartRow) ' Save the one Incorrect GSTIN into IncorrectGSTIN_Array
End If
'
.Sort.SortFields.Clear ' Clear the sort fields
.Range("A2:V" & LastRowRenamedSheet).Sort Key1:=.Range(MainColumn & "2"), _
Order1:=xlAscending, Header:=xlNo ' Sort RenamedPurchasesSheet by column B
End With
'
With WS
.Sort.SortFields.Clear ' Clear the sort fields
.Range("A2:" & MainColumn & LastRow).Sort Key1:=.Range(MainColumn & "2"), _
Order1:=xlAscending, Header:=xlNo ' Sort 'Purchases' sheet by column B
'
If IsArray(IncorrectGSTIN_Array) Then ' If IncorrectGSTIN_Array is an array of values then ...
For ArrayRow = 1 To UBound(IncorrectGSTIN_Array, 1) ' Loop through rows of IncorrectGSTIN_Array
For RowCount = 2 To LastRow ' Loop through rows of 'Purchases' sheet
If .Range(MainColumn & RowCount).Value = _
IncorrectGSTIN_Array(ArrayRow, 1) Then ' If 'Purchases' sheet row =
' ' IncorrectGSTIN_Array then ...
.Range("A" & RowCount & ":B" & RowCount).Interior.Color = 65535 ' Color the row yellow
End If
Next ' Loop back
Next ' Loop back
Else ' Else ...
For RowCount = 2 To LastRow ' Loop through rows of 'Purchases' sheet
If .Range(MainColumn & RowCount).Value = IncorrectGSTIN_Array Then ' If 'Purchases' sheet row =
' ' IncorrectGSTIN_Array then ...
.Range("A" & RowCount & ":B" & RowCount).Interior.Color = 65535 ' Color the row yellow
End If
Next ' Loop back
End If
'
.Sort.SortFields.Clear ' Clear the sort fields
.Range("A2:" & MainColumn & LastRow).Sort Key1:=.Range("A2"), _
Order1:=xlAscending, Header:=xlNo ' Sort 'Purchases' sheet by column A
End With
'
MsgBox "GSTIN not matching. Check & Edit." ' Notify user that at least one GSTIN didn't match
End If
'
WrapUp:
Debug.Print "Time elapsed = " & (MicroTimer - StartTime) & " seconds." ' Display Elapsed Time into Immediate Window (CTRL+G)
MsgBox "Completed." ' Notify user that the script has finished
End Sub
Public Function MicroTimer() As Double ' Precision depends on the frequency of the CPU in the computer
'
' Code by Charles Williams originally
' Uses Windows API calls to the high resolution timer
' Returns time in seconds
'
Dim cyTicks1 As Currency
Static cyFrequency As Currency
'
MicroTimer = 0 ' Initialize MicroTimer to zero
'
If cyFrequency = 0 Then getFrequency cyFrequency ' Get ticks/second aka frequency
'
getTickCount cyTicks1 ' Get # of ticks
'
If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency ' Calculate seconds ... seconds = Ticks/Frequency
End Function
