Option Explicit
Dim DestinationLastRow As Long
Dim DestinationRemarksColumn As String
Dim wsDestination As Worksheet
Sub New_Updated()
Application.ScreenUpdating = False
Dim DestinationSheetExists As Boolean, MatchedSheetExists As Boolean, MismatchesSheetExists As Boolean
Dim ArrayColumn As Long, ArrayRow As Long
Dim ColumnFirstBlankValueRow As Long
Dim MatchedRow As Long, MismatchesRow As Long
Dim OutputArrayRow As Long, SourceArrayRow As Long
Dim SourceDataStartRow As Long, SourceLastRow As Long
Dim Cel As Range
Dim DestinationSheet As String, MatchedSheet As String, MismatchesSheet As String
Dim SourceSheet As String
Dim HeaderTitle As String
Dim SourceDataLastWantedColumn As String, SourceDataStartColumn As String
Dim DestintionArray As Variant, OutputArray As Variant, SourceArray As Variant
Dim HeaderTitlesToPaste As Variant
Dim MatchedArray As Variant, MismatchesArray As Variant
Dim wsMatched As Worksheet, wsMismatches As Worksheet
Dim wsSource As Worksheet, ws As Worksheet
DestinationSheet = "Edited Portal"
SourceSheet = "PORTAL"
MatchedSheet = "Matched"
MismatchesSheet = "Mismatches"
DestinationRemarksColumn = "J"
SourceDataLastWantedColumn = "P"
SourceDataStartColumn = "A"
SourceDataStartRow = 7
On Error Resume Next
Set wsDestination = Sheets(DestinationSheet)
Set wsSource = Sheets(SourceSheet)
Set wsMatched = Sheets(MatchedSheet)
Set wsMismatches = Sheets(MismatchesSheet)
On Error GoTo 0
If Not wsDestination Is Nothing Then DestinationSheetExists = True
If DestinationSheetExists = False Then
Sheets.Add(after:=wsSource).Name = DestinationSheet
Set wsDestination = Sheets(DestinationSheet)
End If
If Not wsMatched Is Nothing Then MatchedSheetExists = True
If MatchedSheetExists = False Then
Sheets.Add(after:=wsSource).Name = MatchedSheet
Set wsMatched = Sheets(MatchedSheet)
End If
If Not wsMismatches Is Nothing Then MismatchesSheetExists = True
If MatchedSheetExists = False Then
Sheets.Add(after:=wsSource).Name = MismatchesSheet
Set wsMismatches = Sheets(MismatchesSheet)
End If
SourceLastRow = wsSource.Range("A" & Rows.Count).End(xlUp).Row
SourceArray = wsSource.Range(SourceDataStartColumn & SourceDataStartRow & _
":" & SourceDataLastWantedColumn & SourceLastRow)
ReDim OutputArray(1 To UBound(SourceArray, 1), 1 To UBound(SourceArray, 2))
OutputArrayRow = 0
For SourceArrayRow = 1 To UBound(SourceArray, 1)
If Right$(Application.Trim(SourceArray(SourceArrayRow, 3)), 6) = "-Total" Then
OutputArrayRow = OutputArrayRow + 1
OutputArray(OutputArrayRow, 1) = OutputArrayRow
OutputArray(OutputArrayRow, 2) = "PORTAL"
OutputArray(OutputArrayRow, 3) = SourceArray(SourceArrayRow, 1)
OutputArray(OutputArrayRow, 4) = SourceArray(SourceArrayRow, 2)
OutputArray(OutputArrayRow, 5) = Replace(SourceArray(SourceArrayRow, 3), _
"-Total", "")
OutputArray(OutputArrayRow, 6) = SourceArray(SourceArrayRow, 5)
OutputArray(OutputArrayRow, 7) = SourceArray(SourceArrayRow, 11)
OutputArray(OutputArrayRow, 8) = SourceArray(SourceArrayRow, 12)
OutputArray(OutputArrayRow, 9) = SourceArray(SourceArrayRow, 13)
OutputArray(OutputArrayRow, 11) = SourceArray(SourceArrayRow, 6)
OutputArray(OutputArrayRow, 12) = SourceArray(SourceArrayRow, 10)
OutputArray(OutputArrayRow, 13) = SourceArray(SourceArrayRow, 16)
OutputArray(OutputArrayRow, 15) = "As Per Portal"
End If
Next
wsDestination.UsedRange.Clear
wsMatched.UsedRange.Clear
wsMismatches.UsedRange.Clear
HeaderTitlesToPaste = Array("Line", "As Per", "GSTIN of supplier", _
"Trade/Legal name of the Supplier", "Invoice number", "Invoice Date", _
"Integrated Tax", "Central Tax", "State/UT", "Remarks", "Invoice Value", _
"Taxable Value", "Filing Date", "Narration", "Data from")
wsDestination.Range("A1:O1").Value = HeaderTitlesToPaste
wsMatched.Range("A1:O1").Value = HeaderTitlesToPaste
wsMismatches.Range("A1:O1").Value = HeaderTitlesToPaste
wsDestination.Columns("F:F").NumberFormat = "@"
wsDestination.Range("A2").Resize(UBound(OutputArray, 1), UBound(OutputArray, 2)) = OutputArray
DestinationLastRow = wsDestination.Range("A" & wsDestination.Rows.Count).End(xlUp).Row
wsDestination.Range("N2:N" & DestinationLastRow).Formula = "=$C$1 & "" "" & C2" & _
" & "" "" & $D$1 & "" "" & D2 & "" "" & $E$1 & "" "" & E2" & _
" & "" "" & $F$1 & "" "" & TEXT(F2,""dd-mm-yyyy"") & "" "" & $K$1" & _
" & "" "" & K2 & "" "" & $M$1 & "" "" & TEXT(M2,""DD-MM-YYYY"")"
wsDestination.Range("O2:O" & DestinationLastRow) = "As Per Portal"
wsDestination.Range("G:I", "K:L").NumberFormat = "0.00"
wsDestination.Range("N2:N" & DestinationLastRow).Copy
wsDestination.Range("N2:N" & DestinationLastRow).PasteSpecial xlPasteValues
Application.CutCopyMode = False
wsDestination.Range("F:F").NumberFormat = "dd-mm-yyyy"
wsDestination.Columns("F:F").TextToColumns Destination:=Range("F1"), _
DataType:=xlDelimited, FieldInfo:=Array(1, 4)
wsDestination.Range("M:M").NumberFormat = "dd-mm-yyyy"
wsDestination.Columns("M:M").TextToColumns Destination:=Range("M1"), _
DataType:=xlDelimited, FieldInfo:=Array(1, 4)
wsDestination.Range("B2:M" & DestinationLastRow).Interior.Color = RGB(146, 208, 80)
wsDestination.Range("B2:M" & DestinationLastRow).Font.Bold = True
For Each ws In Worksheets
Select Case ws.Name
Case Is = SourceSheet, DestinationSheet, "Expected Result", "Matched", _
"Mismatches"
Case Else
Call GetDataFromDataSheet(ws.Name)
End Select
Next
DestinationLastRow = wsDestination.Range("A" & _
wsDestination.Rows.Count).End(xlUp).Row
HeaderTitle = "Integrated Tax"
Call SortColumnAndApplyFormulas(HeaderTitle)
HeaderTitle = "Central Tax"
Call SortColumnAndApplyFormulas(HeaderTitle)
wsDestination.UsedRange.EntireColumn.AutoFit
DestintionArray = wsDestination.Range("A2:" & SourceDataLastWantedColumn & _
DestinationLastRow)
ReDim MatchedArray(1 To UBound(DestintionArray, 1), 1 To UBound(DestintionArray, 2))
ReDim MismatchesArray(1 To UBound(DestintionArray, 1), 1 To UBound(DestintionArray, 2))
MatchedRow = 0
MismatchesRow = 0
For ArrayRow = 1 To UBound(DestintionArray, 1)
On Error GoTo ErrorFound
Select Case DestintionArray(ArrayRow, 10)
Case Is = "Matched"
MatchedRow = MatchedRow + 1
For ArrayColumn = 1 To UBound(DestintionArray, 2)
MatchedArray(MatchedRow, ArrayColumn) = DestintionArray(ArrayRow, ArrayColumn)
Next
Case Else
ErrorFound:
Resume Continue
Continue:
On Error GoTo 0
MismatchesRow = MismatchesRow + 1
For ArrayColumn = 1 To UBound(DestintionArray, 2)
MismatchesArray(MismatchesRow, ArrayColumn) = DestintionArray(ArrayRow, ArrayColumn)
Next
End Select
Next
wsMatched.Range("A2").Resize(UBound(MatchedArray, 1), UBound(MatchedArray, 2)) = MatchedArray
wsMismatches.Range("A2").Resize(UBound(MismatchesArray, 1), UBound(MismatchesArray, 2)) = MismatchesArray
For Each Cel In wsMatched.Range("B2:B" & wsMatched.Range("B" & Rows.Count).End(xlUp).Row)
If Cel.Value = "PORTAL" Then
Cel.EntireRow.Interior.Color = RGB(146, 208, 80)
Cel.EntireRow.Font.Bold = True
End If
Next
For Each Cel In wsMismatches.Range("B2:B" & wsMismatches.Range("B" & Rows.Count).End(xlUp).Row)
If Cel.Value = "PORTAL" Then
Cel.EntireRow.Interior.Color = RGB(146, 208, 80)
Cel.EntireRow.Font.Bold = True
End If
Next
wsDestination.Range("A2:O" & wsDestination.Range("B" & Rows.Count).End(xlUp).Row).Sort _
Key1:=wsDestination.Range("C2"), Order1:=xlAscending, _
Key2:=wsDestination.Range("F2"), Order1:=xlAscending, _
Key3:=wsDestination.Range("B2"), Order1:=xlAscending, Header:=xlNo
wsMatched.Range("A2:O" & wsMatched.Range("B" & Rows.Count).End(xlUp).Row).Sort _
Key1:=wsMatched.Range("C2"), Order1:=xlAscending, _
Key2:=wsMatched.Range("F2"), Order1:=xlAscending, _
Key3:=wsMatched.Range("B2"), Order1:=xlAscending, Header:=xlNo
wsMismatches.Range("A2:O" & wsMismatches.Range("B" & Rows.Count).End(xlUp).Row).Sort _
Key1:=wsMismatches.Range("C2"), Order1:=xlAscending, _
Key2:=wsMismatches.Range("F2"), Order1:=xlAscending, _
Key3:=wsMismatches.Range("B2"), Order1:=xlAscending, Header:=xlNo
wsMatched.UsedRange.EntireColumn.AutoFit
wsMismatches.UsedRange.EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Sub GetDataFromDataSheet(DataWorkSheet As String)
Dim ArrayColumn As Long, ArrayRow As Long
Dim CorrectedColumn As Long
Dim DataLastColumn As String, DataLastRow As Long, DestinationStartRow As Long
Dim CorrectedDataArray As Variant
Dim DataSheetArray As Variant
DataLastRow = Sheets(DataWorkSheet).Range("B" & _
Sheets(DataWorkSheet).Rows.Count).End(xlUp).Row
DataLastColumn = Split(Cells(1, (Sheets(DataWorkSheet).Cells.Find("*", _
, xlFormulas, , xlByColumns, xlPrevious).Column)).Address, "$")(1)
Sheets(DataWorkSheet).Range("C2:C" & DataLastRow) = "As Per " & DataWorkSheet
DataSheetArray = Sheets(DataWorkSheet).Range("A2:" & _
DataLastColumn & DataLastRow)
ReDim CorrectedDataArray(1 To UBound(DataSheetArray, 1), _
1 To UBound(DataSheetArray, 2) - 2)
CorrectedColumn = 0
For ArrayRow = 1 To UBound(DataSheetArray, 1)
For ArrayColumn = 2 To UBound(DataSheetArray, 2)
Select Case ArrayColumn
Case 3:
Case Else
CorrectedColumn = CorrectedColumn + 1
CorrectedDataArray(ArrayRow, CorrectedColumn) = _
DataSheetArray(ArrayRow, ArrayColumn)
End Select
Next
CorrectedColumn = 0
Next
DestinationStartRow = DestinationLastRow + 1
wsDestination.Range("B" & DestinationStartRow).Resize(UBound(CorrectedDataArray, _
1), UBound(CorrectedDataArray, 2)) = CorrectedDataArray
DestinationLastRow = wsDestination.Range("B" & _
wsDestination.Rows.Count).End(xlUp).Row
wsDestination.Range("O" & DestinationStartRow & ":O" & _
DestinationLastRow) = DataSheetArray(1, 3)
wsDestination.Range("A" & DestinationStartRow & _
":A" & DestinationLastRow).Formula = "=Row() - 1"
wsDestination.Range("A" & DestinationStartRow & ":A" & DestinationLastRow).Copy
wsDestination.Range("A" & DestinationStartRow & ":A" & _
DestinationLastRow).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub
Sub SortColumnAndApplyFormulas(HeaderTitle As String)
Dim ColumnFirstZeroValueRow As Long
Dim DSCol As String
Dim FormulaReplacementString1 As String
DSCol = Split(Cells(1, wsDestination.Range("1:1").Find(HeaderTitle).Column).Address, "$")(1)
wsDestination.Range("A2:O" & DestinationLastRow). _
Sort Key1:=wsDestination.Range(DSCol & "2"), Order1:=xlDescending, Header:=xlNo
ColumnFirstZeroValueRow = wsDestination.Range(DSCol & "1:" & DSCol & wsDestination.Range("A" & _
Rows.Count).End(xlUp).Row).Find(what:=0, LookAt:=xlWhole, SearchDirection:=xlNext).Row
FormulaReplacementString1 = "MIN(SUM(IF(($C$2:$C$20000=C2)*(ABS(" & DSCol & "2-$" & DSCol & "$2:$" & _
DSCol & "$20000)<=1)*($B$2:$B$20000=""PORTAL""),1,0)),SUM(IF(($C$2:$C$20000=C2)*(ABS(" & _
DSCol & "2-$" & DSCol & "$2:$" & DSCol & "$20000)<=1)*($B$2:$B$20000=""TALLY""),1,0)))"
With wsDestination.Range(DestinationRemarksColumn & "2")
.FormulaArray = "=IFERROR(IF(ROW(B2)<=SMALL(IF((ABS(" & DSCol & "2-$" & DSCol & "$2:$" & DSCol & _
"$20000)<=1)*(C2=$C$2:$C$20000)*(B2=$B$2:$B$20000),ROW($A$2:$A$20000),""""),xxxxxx)" & _
",""Matched"",NA()),NA())"
.Replace "xxxxxx", FormulaReplacementString1, xlPart
End With
wsDestination.Range(DestinationRemarksColumn & "2").AutoFill wsDestination.Range(DestinationRemarksColumn & _
"2:" & DestinationRemarksColumn & ColumnFirstZeroValueRow - 1)
wsDestination.Range(DestinationRemarksColumn & "2:" & DestinationRemarksColumn & _
ColumnFirstZeroValueRow - 1).Copy
wsDestination.Range(DestinationRemarksColumn & "2:" & DestinationRemarksColumn & _
ColumnFirstZeroValueRow - 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub