Need expert help to add / edit Code

RAJESH1960

RAJESH1960

Banned for repeated rules violations
Joined
Mar 26, 2020
Messages
2,313
Office Version
  1. 2019
Platform
  1. Windows
Hello experts,
This is how I match Portal & Tally - Valid only for up to 20,000 rows of data because of the range in the formula. I change the range in the formula if the rows are more than that.
First, I Check the Integrated Tax column, if it is not in column G, then I shift it to column G. Then, Sort data by "Integrated Tax" > largest to smallest. Enter formula in J2 with control + Shift + Enter
Rich (BB code): 
=IFERROR(IF(ROW(B2)<=SMALL(IF((ABS(G2-$G$2:$G$20000)<=1)*(C2=$C$2:$C$20000)*(B2=$B$2:$B$20000),ROW($A$2:$A$20000),""),MIN(SUM(IF(($C$2:$C$20000=C2)*(ABS(G2-$G$2:$G$20000)<=1)*($B$2:$B$20000="PORTAL"),1,0)),SUM(IF(($C$2:$C$20000=C2)*(ABS(G2-$G$2:$G$20000)<=1)*($B$2:$B$20000="TALLY"),1,0)))),"Matched",NA()),NA())

Drag down only till the cell values are >0 in "Integrated Tax" column. Copy the result and paste it back with paste special to remove the formulas. Next I shift the Central Tax column to G2. Then again, Sort data by Central Tax > largest to smallest. Enter formula in J2 with control + Shift + Enter
Rich (BB code): 
=IFERROR(IF(ROW(B2)<=SMALL(IF((ABS(G2-$G$2:$G$20000)<=1)*(C2=$C$2:$C$20000)*(B2=$B$2:$B$20000),ROW($A$2:$A$20000),""),MIN(SUM(IF(($C$2:$C$20000=C2)*(ABS(G2-$G$2:$G$20000)<=1)*($B$2:$B$20000="PORTAL"),1,0)),SUM(IF(($C$2:$C$20000=C2)*(ABS(G2-$G$2:$G$20000)<=1)*($B$2:$B$20000="TALLY"),1,0)))),"Matched",NA()),NA())

Drag down only till the cell values are >0 in "Central Tax" column. Copy the result and paste it back with paste special to remove the formulas. I change the contents of the column J2 from formula to values, which I do by copying the whole column and pasting it back with paste special values. There are instances when there are blanks in both IGST & CGST. Those too will be treated as mismatches. Finally, without deleting the Edited Portal sheet, I have to divide it into 2 sheets. One with matches and the other with mismatches, i.e., errors. In this case, as it is a sample data there is just only one mismatch. In original data, up to 20% of the data may have mismatches. This will complete 80% of the manual work involved. With your help & expertise
Please note: There is a possibility that the Invoice Date and Invoice Number may be different in Tally from Portal in most of the cases. Most of the Invoice number could be a partial match. The dates may be an exact match to a certain extent (50%). So, it is not a good idea to consider these columns to match between the two.
The CGST & CGST amount are always the same (99.99%).
The only common values between the 2 is the GSTIN number.
Thank you in advance.
Code to Match Portal & Tally.xlsm
 
Sort by date Sort by votes
Issue 2. The 3 sheets are inserted by the code - Edited Portal, Matched and Mismatched. When the new data is ready to be matched, those sheets are not there. So, when I run the code, I get an Automation error. When I press debug it shows the line
Rich (BB code): 
    wsDestination.UsedRange.Clear                                                                   ' Delete previous contents from destination sheet
Wierd, it runs when I run the code again without making any changes.
This is the new updated worksheet without the 3 sheets - Edited Portal, Matched and Mismatched.
For Swing 2.Code to Match Portal & Tally.xlsm
 
Upvote 0
Swing #2:

VBA Code: 
    Option Explicit

    Dim DestinationLastRow          As Long
    Dim DestinationRemarksColumn    As String
    Dim wsDestination               As Worksheet

Sub New_Updated()
'
'solved by JohnnyL 30-03-2022
'Updated on 04-04-2022
'Updated on 05-04-2022 11:30
'
    Application.ScreenUpdating = False                                          ' Turn ScreenUpdating off
'
    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 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"                                          ' <--- Set this to the name of the sheet to store the shortened Portal data into
         SourceSheet = "PORTAL"                                                 ' <--- Set this to the Portal sheet that you want data from
        MatchedSheet = "Matched"                                                ' <--- Set this to the Matched sheet that you copy matches to
     MismatchesSheet = "Mismatches"                                             ' <--- Set this to the Mismatches sheet that you copy mismatches to
'
      DestinationRemarksColumn = "J"                                            ' <--- Set this to the 'Remarks' column letter
    SourceDataLastWantedColumn = "P"                                            ' <--- Set this to the last column of wanted data on the source sheet
         SourceDataStartColumn = "A"                                            ' <--- Set this to the starting column of wanted data on the source sheet
            SourceDataStartRow = 7                                              ' <--- Set this to the starting row of data on the source sheet
'
    On Error Resume Next                                                                    ' Bypass error generated in next line if sheet does not exist
    Set wsDestination = Sheets(DestinationSheet)                                            ' Assign DestinationSheet to wsDestination
         Set wsSource = Sheets(SourceSheet)                                                 ' Assign SourceSheet to wsSource
        Set wsMatched = Sheets(MatchedSheet)                                                ' Assign MatchedSheet to wsMatched
     Set wsMismatches = Sheets(MismatchesSheet)                                             ' Assign MismatchesSheet to wsMismatches
    On Error GoTo 0                                                                         ' Turn Excel error handling back on
'
' Create DestinationSheet if it doesn't exist
    If Not wsDestination Is Nothing Then DestinationSheetExists = True                      ' Check to see if the DestinationSheet exists
    If DestinationSheetExists = False Then                                                  ' If DestinationSheet does not exist then ...
        Sheets.Add(after:=wsSource).Name = DestinationSheet                                 '   Create the DestinationSheet after the Source sheet
        Set wsDestination = Sheets(DestinationSheet)                                        '   Assign the DestinationSheet to wsDestination
    End If
'
' Create MatchedSheet if it doesn't exist
    If Not wsMatched Is Nothing Then MatchedSheetExists = True                              ' Check to see if the MatchedSheet exists
    If MatchedSheetExists = False Then                                                      ' If MatchedSheet does not exist then ...
        Sheets.Add(after:=wsSource).Name = MatchedSheet                                     '   Create the MatchedSheet after the Source sheet
        Set wsMatched = Sheets(MatchedSheet)                                                '   Assign the MatchedSheet to wsMatched
    End If
'
' Create MismatchesSheet if it doesn't exist
    If Not wsMismatches Is Nothing Then MismatchesSheetExists = True                        ' Check to see if the MismatchesSheet exists
    If MatchedSheetExists = False Then                                                      ' If MismatchesSheet does not exist then ...
        Sheets.Add(after:=wsSource).Name = MismatchesSheet                                  '   Create the MismatchesSheet after the Source sheet
        Set wsMismatches = Sheets(MismatchesSheet)                                          '   Assign the MismatchesSheet to wsMismatches
    End If
'
'---------------------------------------------------------------
'
    SourceLastRow = wsSource.Range("A" & Rows.Count).End(xlUp).Row                          ' Get last row used in column A of the source sheeet
'
    SourceArray = wsSource.Range(SourceDataStartColumn & SourceDataStartRow & _
            ":" & SourceDataLastWantedColumn & SourceLastRow)                               ' Load all needed data from source sheet to 2D 1 based SourceArray RC
'
    ReDim OutputArray(1 To UBound(SourceArray, 1), 1 To UBound(SourceArray, 2))             ' Establish # of rows/columns in 2D 1 based OutputArray
    OutputArrayRow = 0                                                                      ' Initialize OutputArrayRow
'
    For SourceArrayRow = 1 To UBound(SourceArray, 1)                                        ' Loop through all rows of SourceArray
        If Right$(Application.Trim(SourceArray(SourceArrayRow, 3)), 6) = "-Total" Then      '   If a total cell is found in the array then ...(3 represents column C)
            OutputArrayRow = OutputArrayRow + 1                                             '       Increment OutputArrayRow
'
            OutputArray(OutputArrayRow, 1) = OutputArrayRow                                 ' Row #
            OutputArray(OutputArrayRow, 2) = "PORTAL"                                       ' 'PORTAL'
'
            OutputArray(OutputArrayRow, 3) = SourceArray(SourceArrayRow, 1)                 ' GSTIN
            OutputArray(OutputArrayRow, 4) = SourceArray(SourceArrayRow, 2)                 ' Name of supplier
            OutputArray(OutputArrayRow, 5) = Replace(SourceArray(SourceArrayRow, 3), _
                    "-Total", "")                                                           ' Invoice #
            OutputArray(OutputArrayRow, 6) = SourceArray(SourceArrayRow, 5)                 ' Invoice Date
'
            OutputArray(OutputArrayRow, 7) = SourceArray(SourceArrayRow, 11)                ' Integrated Tax
            OutputArray(OutputArrayRow, 8) = SourceArray(SourceArrayRow, 12)                ' Central Tax
            OutputArray(OutputArrayRow, 9) = SourceArray(SourceArrayRow, 13)                ' State/UT Tax
'
            OutputArray(OutputArrayRow, 11) = SourceArray(SourceArrayRow, 6)                ' Invoice value
            OutputArray(OutputArrayRow, 12) = SourceArray(SourceArrayRow, 10)               ' Taxable value
            OutputArray(OutputArrayRow, 13) = SourceArray(SourceArrayRow, 16)               ' Filing Date
'
            OutputArray(OutputArrayRow, 15) = "As Per Portal"                               ' 'As Per Portal'
        End If
    Next
'
'---------------------------------------------------------------
'
    wsDestination.UsedRange.Clear                                                                   ' Delete previous contents from destination sheet
    wsMatched.UsedRange.Clear                                                                       ' Delete any previous contents from MatchedSheet
    wsMismatches.UsedRange.Clear                                                                    ' Delete any previous contents from MismatchesSheet
'
    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")                               ' Header row to paste to desired sheets
'
' Write header values into the DestinationSheet, MatchedSheet, & MismatchesSheet
    wsDestination.Range("A1:O1").Value = HeaderTitlesToPaste                                        ' Write header row to DestinationSheet
        wsMatched.Range("A1:O1").Value = HeaderTitlesToPaste                                        ' Write header row to MatchedSheet
        wsMismatches.Range("A1:O1").Value = HeaderTitlesToPaste                                     ' Write header row to MismatchesSheet
'
    wsDestination.Columns("F:F").NumberFormat = "@"                                                 ' Set column to text format to prevent excel changing dates
    wsDestination.Range("A2").Resize(UBound(OutputArray, 1), UBound(OutputArray, 2)) = OutputArray  ' Display results to DestinationSheet
'
    DestinationLastRow = wsDestination.Range("A" & wsDestination.Rows.Count).End(xlUp).Row          ' Get last row used in column A of the destination sheeet
'
    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"")"                       ' Copy Narration Formula to Column N
'
    wsDestination.Range("O2:O" & DestinationLastRow) = "As Per Portal"                              ' Copy 'As Per Portal' to Column O
    wsDestination.Range("G:I", "K:L").NumberFormat = "0.00"                                         ' Set columns to numeric with 2 decimal places
'
    wsDestination.Range("N2:N" & DestinationLastRow).Copy                                           ' Copy formula range into memory
    wsDestination.Range("N2:N" & DestinationLastRow).PasteSpecial xlPasteValues                     ' Paste just the vales back to range
    Application.CutCopyMode = False                                                                 ' Clear clipboard & 'marching ants' around copied range
'
    wsDestination.Range("F:F").NumberFormat = "dd-mm-yyyy"                                          ' Format the date the way we want it to appear
    wsDestination.Columns("F:F").TextToColumns Destination:=Range("F1"), _
            DataType:=xlDelimited, FieldInfo:=Array(1, 4)                                           ' Convert text to numeric
'
    wsDestination.Range("M:M").NumberFormat = "dd-mm-yyyy"                                          ' Format the date the way we want it to appear
    wsDestination.Columns("M:M").TextToColumns Destination:=Range("M1"), _
            DataType:=xlDelimited, FieldInfo:=Array(1, 4)                                           ' Convert text to numeric
'
    wsDestination.Range("B2:M" & DestinationLastRow).Interior.Color = RGB(146, 208, 80)             ' Highlight the range green
    wsDestination.Range("B2:M" & DestinationLastRow).Font.Bold = True                               ' Make the range Bold
'
'---------------------------------------------------------------
'
    For Each ws In Worksheets                                                                       ' Loop through all worksheets in the workbook
        Select Case ws.Name
            Case Is = SourceSheet, DestinationSheet, "Expected Result", "Matched", _
                    "Mismatches"                                                                    '       List of sheets to exclude
'               Skip these sheets
            Case Else                                                                               '       All other sheets ...
                Call GetDataFromDataSheet(ws.Name)                                                  '           Pass sheet name to the sub routine
        End Select
    Next                                                                                            ' Loop back
'
'---------------------------------------------------------------
'
    DestinationLastRow = wsDestination.Range("A" & _
            wsDestination.Rows.Count).End(xlUp).Row                                                 ' Get last row used in column A of the destination sheeet
'
    HeaderTitle = "Integrated Tax"                                                                  ' Set the header title we will look for & sort
    Call SortColumnAndApplyFormulas(HeaderTitle)                                                    ' Pass HeaderTitle to the sub routine
'
    HeaderTitle = "Central Tax"                                                                     ' Set the header title we will look for & sort
    Call SortColumnAndApplyFormulas(HeaderTitle)                                                    ' Pass HeaderTitle to the sub routine
'
    wsDestination.UsedRange.EntireColumn.AutoFit                                                    ' Autofit all of the columns on the destination Sheet
'
'---------------------------------------------------------------
'
    DestintionArray = wsDestination.Range("A2:" & SourceDataLastWantedColumn & _
            DestinationLastRow)                                                                     ' Load all needed data from destination sheet to
'                                                                                                   '   2D 1 based DestintionArray RC
    ReDim MatchedArray(1 To UBound(DestintionArray, 1), 1 To UBound(DestintionArray, 2))            ' Set the # of rows and columns for MatchedArray
    ReDim MismatchesArray(1 To UBound(DestintionArray, 1), 1 To UBound(DestintionArray, 2))         ' Set the # of rows and columns for MismatchesArray
'
    MatchedRow = 0                                                                                  ' Initialize MatchedRow
    MismatchesRow = 0                                                                               ' Initialize MismatchesRow
'
   For ArrayRow = 1 To UBound(DestintionArray, 1)                                                   ' Loop through DestintionArray rows
        On Error GoTo ErrorFound
'
        Select Case DestintionArray(ArrayRow, 10)                                                   '   Get value from column J
            Case Is = "Matched"                                                                     '       If value = 'Matched' then ...
                MatchedRow = MatchedRow + 1                                                         '           Increment MatchedRow
'
                For ArrayColumn = 1 To UBound(DestintionArray, 2)                                   '           Loop through DestintionArray columns
                    MatchedArray(MatchedRow, ArrayColumn) = DestintionArray(ArrayRow, ArrayColumn)  '               Save Destination cell to MatchedArray
                Next                                                                                '           Loop back
            Case Else
ErrorFound:
                Resume Continue                                                                     '           Clear error if it exists
Continue:
                On Error GoTo 0                                                                     '           Turn Excel error handling back on
                MismatchesRow = MismatchesRow + 1                                                   '           Increment MismatchesRow
'
                For ArrayColumn = 1 To UBound(DestintionArray, 2)                                   '           Loop through DestintionArray columns
                    MismatchesArray(MismatchesRow, ArrayColumn) = DestintionArray(ArrayRow, ArrayColumn)  '               Save Destination cell to MismatchesArray
                Next                                                                                '           Loop back
        End Select
    Next                                                                                            ' Loop back
'
    wsMatched.Range("A2").Resize(UBound(MatchedArray, 1), UBound(MatchedArray, 2)) = MatchedArray               ' Display results to Matched sheet
    wsMismatches.Range("A2").Resize(UBound(MismatchesArray, 1), UBound(MismatchesArray, 2)) = MismatchesArray   ' Display results to Mismatches sheet
'
    wsMatched.UsedRange.EntireColumn.AutoFit                                                        ' Autofit all of the columns on the MatchedSheet
    wsMismatches.UsedRange.EntireColumn.AutoFit                                                     ' Autofit all of the columns on the MismatchesSheet
'
    Application.ScreenUpdating = True                                                               ' Turn ScreenUpdating back on
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                                         ' Get last row of the Data sheet column B
'
    DataLastColumn = Split(Cells(1, (Sheets(DataWorkSheet).Cells.Find("*", _
            , xlFormulas, , xlByColumns, xlPrevious).Column)).Address, "$")(1)                      ' Get last column letter of the Data sheet
'
    Sheets(DataWorkSheet).Range("C2:C" & DataLastRow) = "As Per " & DataWorkSheet                   ' Copy 'AS PER ' & sheet name to Column C of the sheet
'
    DataSheetArray = Sheets(DataWorkSheet).Range("A2:" & _
            DataLastColumn & DataLastRow)                                                           ' Load Data from Data sheet to 2D 1 based DataSheetArray
'
    ReDim CorrectedDataArray(1 To UBound(DataSheetArray, 1), _
            1 To UBound(DataSheetArray, 2) - 2)                                                     ' Set the number of rows & columns for the CorrectedDataArray
'
    CorrectedColumn = 0                                                                             ' Initialize CorrectedColumn
'
    For ArrayRow = 1 To UBound(DataSheetArray, 1)                                                   ' Loop through the rows of DataSheetArray
        For ArrayColumn = 2 To UBound(DataSheetArray, 2)                                            '   Loop through the columns of DataSheetArray
            Select Case ArrayColumn
                Case 3: ' Skip this Column
                Case Else
                    CorrectedColumn = CorrectedColumn + 1                                           '       Increment CorrectedColumn
'
                    CorrectedDataArray(ArrayRow, CorrectedColumn) = _
                            DataSheetArray(ArrayRow, ArrayColumn)                                   '       Save DataSheetArray data into CorrectedDataArray
            End Select
        Next                                                                                        '   Loop back
'
        CorrectedColumn = 0                                                                         '   Reset CorrectedColumn
    Next                                                                                            ' Loop back
'
    DestinationStartRow = DestinationLastRow + 1                                                    ' Save DestinationLastRow + 1 into DestinationStartRow
'
    wsDestination.Range("B" & DestinationStartRow).Resize(UBound(CorrectedDataArray, _
            1), UBound(CorrectedDataArray, 2)) = CorrectedDataArray                                 ' Display Results to destination sheet
'
    DestinationLastRow = wsDestination.Range("B" & _
            wsDestination.Rows.Count).End(xlUp).Row                                                 ' Recalculate last row used in column B of the destination sheeet
'
    wsDestination.Range("O" & DestinationStartRow & ":O" & _
            DestinationLastRow) = DataSheetArray(1, 3)                                              ' Copy 'As Per ????' to Column O
'
    wsDestination.Range("A" & DestinationStartRow & _
            ":A" & DestinationLastRow).Formula = "=Row() - 1"                                       ' Use formula to set row #s
    wsDestination.Range("A" & DestinationStartRow & ":A" & DestinationLastRow).Copy                 ' Copy formula range into memory
    wsDestination.Range("A" & DestinationStartRow & ":A" & _
            DestinationLastRow).PasteSpecial xlPasteValues                                          ' Paste just the vales back to range
    Application.CutCopyMode = False                                                                 ' Clear clipboard & 'marching ants' around copied range
End Sub


Sub SortColumnAndApplyFormulas(HeaderTitle As String)
'
    Dim ColumnFirstZeroValueRow     As Long
    Dim DSCol                       As String       ' DestinationSortColumn
    Dim FormulaReplacementString1   As String
'
    DSCol = Split(Cells(1, wsDestination.Range("1:1").Find(HeaderTitle).Column).Address, "$")(1)        ' Find Column letter of the HeaderTitle we are looking for
'
'   RANGE SORTER ... Least important column to most important column 7
    wsDestination.Range("A2:O" & DestinationLastRow). _
            Sort Key1:=wsDestination.Range(DSCol & "2"), Order1:=xlDescending, Header:=xlNo             ' Sort HeaderTitle Column highest to lowest
'
    ColumnFirstZeroValueRow = wsDestination.Range(DSCol & "1:" & DSCol & wsDestination.Range("A" & _
            Rows.Count).End(xlUp).Row).Find(what:=0, LookAt:=xlWhole, SearchDirection:=xlNext).Row      ' Locate first row in column with a zero value
'
    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)))"     ' Additional string to insert into formula
'
    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())"                                                              '   Formula to insert into 'Remarks' column
        .Replace "xxxxxx", FormulaReplacementString1, xlPart                                            '   Insert additional string into formula
    End With
'
    wsDestination.Range(DestinationRemarksColumn & "2").AutoFill wsDestination.Range(DestinationRemarksColumn & _
            "2:" & DestinationRemarksColumn & ColumnFirstZeroValueRow - 1)                              ' Drag the formula down till zero value is found
'
    wsDestination.Range(DestinationRemarksColumn & "2:" & DestinationRemarksColumn & _
            ColumnFirstZeroValueRow - 1).Copy                                                           ' Copy formula range into memory
    wsDestination.Range(DestinationRemarksColumn & "2:" & DestinationRemarksColumn & _
            ColumnFirstZeroValueRow - 1).PasteSpecial xlPasteValues                                     ' Paste just the vales back to range
    Application.CutCopyMode = False                                                                     ' Clear clipboard & 'marching ants' around copied range
End Sub

Let me know if that is what you wanted.
 
Upvote 0
johnnyL said:
Swing #2:

VBA Code: 
    Option Explicit

    Dim DestinationLastRow          As Long
    Dim DestinationRemarksColumn    As String
    Dim wsDestination               As Worksheet

Sub New_Updated()
'
'solved by JohnnyL 30-03-2022
'Updated on 04-04-2022
'Updated on 05-04-2022 11:30
'
    Application.ScreenUpdating = False                                          ' Turn ScreenUpdating off
'
    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 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"                                          ' <--- Set this to the name of the sheet to store the shortened Portal data into
         SourceSheet = "PORTAL"                                                 ' <--- Set this to the Portal sheet that you want data from
        MatchedSheet = "Matched"                                                ' <--- Set this to the Matched sheet that you copy matches to
     MismatchesSheet = "Mismatches"                                             ' <--- Set this to the Mismatches sheet that you copy mismatches to
'
      DestinationRemarksColumn = "J"                                            ' <--- Set this to the 'Remarks' column letter
    SourceDataLastWantedColumn = "P"                                            ' <--- Set this to the last column of wanted data on the source sheet
         SourceDataStartColumn = "A"                                            ' <--- Set this to the starting column of wanted data on the source sheet
            SourceDataStartRow = 7                                              ' <--- Set this to the starting row of data on the source sheet
'
    On Error Resume Next                                                                    ' Bypass error generated in next line if sheet does not exist
    Set wsDestination = Sheets(DestinationSheet)                                            ' Assign DestinationSheet to wsDestination
         Set wsSource = Sheets(SourceSheet)                                                 ' Assign SourceSheet to wsSource
        Set wsMatched = Sheets(MatchedSheet)                                                ' Assign MatchedSheet to wsMatched
     Set wsMismatches = Sheets(MismatchesSheet)                                             ' Assign MismatchesSheet to wsMismatches
    On Error GoTo 0                                                                         ' Turn Excel error handling back on
'
' Create DestinationSheet if it doesn't exist
    If Not wsDestination Is Nothing Then DestinationSheetExists = True                      ' Check to see if the DestinationSheet exists
    If DestinationSheetExists = False Then                                                  ' If DestinationSheet does not exist then ...
        Sheets.Add(after:=wsSource).Name = DestinationSheet                                 '   Create the DestinationSheet after the Source sheet
        Set wsDestination = Sheets(DestinationSheet)                                        '   Assign the DestinationSheet to wsDestination
    End If
'
' Create MatchedSheet if it doesn't exist
    If Not wsMatched Is Nothing Then MatchedSheetExists = True                              ' Check to see if the MatchedSheet exists
    If MatchedSheetExists = False Then                                                      ' If MatchedSheet does not exist then ...
        Sheets.Add(after:=wsSource).Name = MatchedSheet                                     '   Create the MatchedSheet after the Source sheet
        Set wsMatched = Sheets(MatchedSheet)                                                '   Assign the MatchedSheet to wsMatched
    End If
'
' Create MismatchesSheet if it doesn't exist
    If Not wsMismatches Is Nothing Then MismatchesSheetExists = True                        ' Check to see if the MismatchesSheet exists
    If MatchedSheetExists = False Then                                                      ' If MismatchesSheet does not exist then ...
        Sheets.Add(after:=wsSource).Name = MismatchesSheet                                  '   Create the MismatchesSheet after the Source sheet
        Set wsMismatches = Sheets(MismatchesSheet)                                          '   Assign the MismatchesSheet to wsMismatches
    End If
'
'---------------------------------------------------------------
'
    SourceLastRow = wsSource.Range("A" & Rows.Count).End(xlUp).Row                          ' Get last row used in column A of the source sheeet
'
    SourceArray = wsSource.Range(SourceDataStartColumn & SourceDataStartRow & _
            ":" & SourceDataLastWantedColumn & SourceLastRow)                               ' Load all needed data from source sheet to 2D 1 based SourceArray RC
'
    ReDim OutputArray(1 To UBound(SourceArray, 1), 1 To UBound(SourceArray, 2))             ' Establish # of rows/columns in 2D 1 based OutputArray
    OutputArrayRow = 0                                                                      ' Initialize OutputArrayRow
'
    For SourceArrayRow = 1 To UBound(SourceArray, 1)                                        ' Loop through all rows of SourceArray
        If Right$(Application.Trim(SourceArray(SourceArrayRow, 3)), 6) = "-Total" Then      '   If a total cell is found in the array then ...(3 represents column C)
            OutputArrayRow = OutputArrayRow + 1                                             '       Increment OutputArrayRow
'
            OutputArray(OutputArrayRow, 1) = OutputArrayRow                                 ' Row #
            OutputArray(OutputArrayRow, 2) = "PORTAL"                                       ' 'PORTAL'
'
            OutputArray(OutputArrayRow, 3) = SourceArray(SourceArrayRow, 1)                 ' GSTIN
            OutputArray(OutputArrayRow, 4) = SourceArray(SourceArrayRow, 2)                 ' Name of supplier
            OutputArray(OutputArrayRow, 5) = Replace(SourceArray(SourceArrayRow, 3), _
                    "-Total", "")                                                           ' Invoice #
            OutputArray(OutputArrayRow, 6) = SourceArray(SourceArrayRow, 5)                 ' Invoice Date
'
            OutputArray(OutputArrayRow, 7) = SourceArray(SourceArrayRow, 11)                ' Integrated Tax
            OutputArray(OutputArrayRow, 8) = SourceArray(SourceArrayRow, 12)                ' Central Tax
            OutputArray(OutputArrayRow, 9) = SourceArray(SourceArrayRow, 13)                ' State/UT Tax
'
            OutputArray(OutputArrayRow, 11) = SourceArray(SourceArrayRow, 6)                ' Invoice value
            OutputArray(OutputArrayRow, 12) = SourceArray(SourceArrayRow, 10)               ' Taxable value
            OutputArray(OutputArrayRow, 13) = SourceArray(SourceArrayRow, 16)               ' Filing Date
'
            OutputArray(OutputArrayRow, 15) = "As Per Portal"                               ' 'As Per Portal'
        End If
    Next
'
'---------------------------------------------------------------
'
    wsDestination.UsedRange.Clear                                                                   ' Delete previous contents from destination sheet
    wsMatched.UsedRange.Clear                                                                       ' Delete any previous contents from MatchedSheet
    wsMismatches.UsedRange.Clear                                                                    ' Delete any previous contents from MismatchesSheet
'
    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")                               ' Header row to paste to desired sheets
'
' Write header values into the DestinationSheet, MatchedSheet, & MismatchesSheet
    wsDestination.Range("A1:O1").Value = HeaderTitlesToPaste                                        ' Write header row to DestinationSheet
        wsMatched.Range("A1:O1").Value = HeaderTitlesToPaste                                        ' Write header row to MatchedSheet
        wsMismatches.Range("A1:O1").Value = HeaderTitlesToPaste                                     ' Write header row to MismatchesSheet
'
    wsDestination.Columns("F:F").NumberFormat = "@"                                                 ' Set column to text format to prevent excel changing dates
    wsDestination.Range("A2").Resize(UBound(OutputArray, 1), UBound(OutputArray, 2)) = OutputArray  ' Display results to DestinationSheet
'
    DestinationLastRow = wsDestination.Range("A" & wsDestination.Rows.Count).End(xlUp).Row          ' Get last row used in column A of the destination sheeet
'
    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"")"                       ' Copy Narration Formula to Column N
'
    wsDestination.Range("O2:O" & DestinationLastRow) = "As Per Portal"                              ' Copy 'As Per Portal' to Column O
    wsDestination.Range("G:I", "K:L").NumberFormat = "0.00"                                         ' Set columns to numeric with 2 decimal places
'
    wsDestination.Range("N2:N" & DestinationLastRow).Copy                                           ' Copy formula range into memory
    wsDestination.Range("N2:N" & DestinationLastRow).PasteSpecial xlPasteValues                     ' Paste just the vales back to range
    Application.CutCopyMode = False                                                                 ' Clear clipboard & 'marching ants' around copied range
'
    wsDestination.Range("F:F").NumberFormat = "dd-mm-yyyy"                                          ' Format the date the way we want it to appear
    wsDestination.Columns("F:F").TextToColumns Destination:=Range("F1"), _
            DataType:=xlDelimited, FieldInfo:=Array(1, 4)                                           ' Convert text to numeric
'
    wsDestination.Range("M:M").NumberFormat = "dd-mm-yyyy"                                          ' Format the date the way we want it to appear
    wsDestination.Columns("M:M").TextToColumns Destination:=Range("M1"), _
            DataType:=xlDelimited, FieldInfo:=Array(1, 4)                                           ' Convert text to numeric
'
    wsDestination.Range("B2:M" & DestinationLastRow).Interior.Color = RGB(146, 208, 80)             ' Highlight the range green
    wsDestination.Range("B2:M" & DestinationLastRow).Font.Bold = True                               ' Make the range Bold
'
'---------------------------------------------------------------
'
    For Each ws In Worksheets                                                                       ' Loop through all worksheets in the workbook
        Select Case ws.Name
            Case Is = SourceSheet, DestinationSheet, "Expected Result", "Matched", _
                    "Mismatches"                                                                    '       List of sheets to exclude
'               Skip these sheets
            Case Else                                                                               '       All other sheets ...
                Call GetDataFromDataSheet(ws.Name)                                                  '           Pass sheet name to the sub routine
        End Select
    Next                                                                                            ' Loop back
'
'---------------------------------------------------------------
'
    DestinationLastRow = wsDestination.Range("A" & _
            wsDestination.Rows.Count).End(xlUp).Row                                                 ' Get last row used in column A of the destination sheeet
'
    HeaderTitle = "Integrated Tax"                                                                  ' Set the header title we will look for & sort
    Call SortColumnAndApplyFormulas(HeaderTitle)                                                    ' Pass HeaderTitle to the sub routine
'
    HeaderTitle = "Central Tax"                                                                     ' Set the header title we will look for & sort
    Call SortColumnAndApplyFormulas(HeaderTitle)                                                    ' Pass HeaderTitle to the sub routine
'
    wsDestination.UsedRange.EntireColumn.AutoFit                                                    ' Autofit all of the columns on the destination Sheet
'
'---------------------------------------------------------------
'
    DestintionArray = wsDestination.Range("A2:" & SourceDataLastWantedColumn & _
            DestinationLastRow)                                                                     ' Load all needed data from destination sheet to
'                                                                                                   '   2D 1 based DestintionArray RC
    ReDim MatchedArray(1 To UBound(DestintionArray, 1), 1 To UBound(DestintionArray, 2))            ' Set the # of rows and columns for MatchedArray
    ReDim MismatchesArray(1 To UBound(DestintionArray, 1), 1 To UBound(DestintionArray, 2))         ' Set the # of rows and columns for MismatchesArray
'
    MatchedRow = 0                                                                                  ' Initialize MatchedRow
    MismatchesRow = 0                                                                               ' Initialize MismatchesRow
'
   For ArrayRow = 1 To UBound(DestintionArray, 1)                                                   ' Loop through DestintionArray rows
        On Error GoTo ErrorFound
'
        Select Case DestintionArray(ArrayRow, 10)                                                   '   Get value from column J
            Case Is = "Matched"                                                                     '       If value = 'Matched' then ...
                MatchedRow = MatchedRow + 1                                                         '           Increment MatchedRow
'
                For ArrayColumn = 1 To UBound(DestintionArray, 2)                                   '           Loop through DestintionArray columns
                    MatchedArray(MatchedRow, ArrayColumn) = DestintionArray(ArrayRow, ArrayColumn)  '               Save Destination cell to MatchedArray
                Next                                                                                '           Loop back
            Case Else
ErrorFound:
                Resume Continue                                                                     '           Clear error if it exists
Continue:
                On Error GoTo 0                                                                     '           Turn Excel error handling back on
                MismatchesRow = MismatchesRow + 1                                                   '           Increment MismatchesRow
'
                For ArrayColumn = 1 To UBound(DestintionArray, 2)                                   '           Loop through DestintionArray columns
                    MismatchesArray(MismatchesRow, ArrayColumn) = DestintionArray(ArrayRow, ArrayColumn)  '               Save Destination cell to MismatchesArray
                Next                                                                                '           Loop back
        End Select
    Next                                                                                            ' Loop back
'
    wsMatched.Range("A2").Resize(UBound(MatchedArray, 1), UBound(MatchedArray, 2)) = MatchedArray               ' Display results to Matched sheet
    wsMismatches.Range("A2").Resize(UBound(MismatchesArray, 1), UBound(MismatchesArray, 2)) = MismatchesArray   ' Display results to Mismatches sheet
'
    wsMatched.UsedRange.EntireColumn.AutoFit                                                        ' Autofit all of the columns on the MatchedSheet
    wsMismatches.UsedRange.EntireColumn.AutoFit                                                     ' Autofit all of the columns on the MismatchesSheet
'
    Application.ScreenUpdating = True                                                               ' Turn ScreenUpdating back on
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                                         ' Get last row of the Data sheet column B
'
    DataLastColumn = Split(Cells(1, (Sheets(DataWorkSheet).Cells.Find("*", _
            , xlFormulas, , xlByColumns, xlPrevious).Column)).Address, "$")(1)                      ' Get last column letter of the Data sheet
'
    Sheets(DataWorkSheet).Range("C2:C" & DataLastRow) = "As Per " & DataWorkSheet                   ' Copy 'AS PER ' & sheet name to Column C of the sheet
'
    DataSheetArray = Sheets(DataWorkSheet).Range("A2:" & _
            DataLastColumn & DataLastRow)                                                           ' Load Data from Data sheet to 2D 1 based DataSheetArray
'
    ReDim CorrectedDataArray(1 To UBound(DataSheetArray, 1), _
            1 To UBound(DataSheetArray, 2) - 2)                                                     ' Set the number of rows & columns for the CorrectedDataArray
'
    CorrectedColumn = 0                                                                             ' Initialize CorrectedColumn
'
    For ArrayRow = 1 To UBound(DataSheetArray, 1)                                                   ' Loop through the rows of DataSheetArray
        For ArrayColumn = 2 To UBound(DataSheetArray, 2)                                            '   Loop through the columns of DataSheetArray
            Select Case ArrayColumn
                Case 3: ' Skip this Column
                Case Else
                    CorrectedColumn = CorrectedColumn + 1                                           '       Increment CorrectedColumn
'
                    CorrectedDataArray(ArrayRow, CorrectedColumn) = _
                            DataSheetArray(ArrayRow, ArrayColumn)                                   '       Save DataSheetArray data into CorrectedDataArray
            End Select
        Next                                                                                        '   Loop back
'
        CorrectedColumn = 0                                                                         '   Reset CorrectedColumn
    Next                                                                                            ' Loop back
'
    DestinationStartRow = DestinationLastRow + 1                                                    ' Save DestinationLastRow + 1 into DestinationStartRow
'
    wsDestination.Range("B" & DestinationStartRow).Resize(UBound(CorrectedDataArray, _
            1), UBound(CorrectedDataArray, 2)) = CorrectedDataArray                                 ' Display Results to destination sheet
'
    DestinationLastRow = wsDestination.Range("B" & _
            wsDestination.Rows.Count).End(xlUp).Row                                                 ' Recalculate last row used in column B of the destination sheeet
'
    wsDestination.Range("O" & DestinationStartRow & ":O" & _
            DestinationLastRow) = DataSheetArray(1, 3)                                              ' Copy 'As Per ????' to Column O
'
    wsDestination.Range("A" & DestinationStartRow & _
            ":A" & DestinationLastRow).Formula = "=Row() - 1"                                       ' Use formula to set row #s
    wsDestination.Range("A" & DestinationStartRow & ":A" & DestinationLastRow).Copy                 ' Copy formula range into memory
    wsDestination.Range("A" & DestinationStartRow & ":A" & _
            DestinationLastRow).PasteSpecial xlPasteValues                                          ' Paste just the vales back to range
    Application.CutCopyMode = False                                                                 ' Clear clipboard & 'marching ants' around copied range
End Sub


Sub SortColumnAndApplyFormulas(HeaderTitle As String)
'
    Dim ColumnFirstZeroValueRow     As Long
    Dim DSCol                       As String       ' DestinationSortColumn
    Dim FormulaReplacementString1   As String
'
    DSCol = Split(Cells(1, wsDestination.Range("1:1").Find(HeaderTitle).Column).Address, "$")(1)        ' Find Column letter of the HeaderTitle we are looking for
'
'   RANGE SORTER ... Least important column to most important column 7
    wsDestination.Range("A2:O" & DestinationLastRow). _
            Sort Key1:=wsDestination.Range(DSCol & "2"), Order1:=xlDescending, Header:=xlNo             ' Sort HeaderTitle Column highest to lowest
'
    ColumnFirstZeroValueRow = wsDestination.Range(DSCol & "1:" & DSCol & wsDestination.Range("A" & _
            Rows.Count).End(xlUp).Row).Find(what:=0, LookAt:=xlWhole, SearchDirection:=xlNext).Row      ' Locate first row in column with a zero value
'
    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)))"     ' Additional string to insert into formula
'
    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())"                                                              '   Formula to insert into 'Remarks' column
        .Replace "xxxxxx", FormulaReplacementString1, xlPart                                            '   Insert additional string into formula
    End With
'
    wsDestination.Range(DestinationRemarksColumn & "2").AutoFill wsDestination.Range(DestinationRemarksColumn & _
            "2:" & DestinationRemarksColumn & ColumnFirstZeroValueRow - 1)                              ' Drag the formula down till zero value is found
'
    wsDestination.Range(DestinationRemarksColumn & "2:" & DestinationRemarksColumn & _
            ColumnFirstZeroValueRow - 1).Copy                                                           ' Copy formula range into memory
    wsDestination.Range(DestinationRemarksColumn & "2:" & DestinationRemarksColumn & _
            ColumnFirstZeroValueRow - 1).PasteSpecial xlPasteValues                                     ' Paste just the vales back to range
    Application.CutCopyMode = False                                                                     ' Clear clipboard & 'marching ants' around copied range
End Sub

Let me know if that is what you wanted.
Click to expand...
Looks perfect. But I do not want to jump to the conclusion so fast. Will check and match with other data and will let you know in sometime. ?
 
Upvote 0
JohnnyL. The result is excellent and perfect. But if you can solve these 2 which are simple I hope will not take much time.
1. In the Matched and Mismatched Sheets the Portal color I would like to retain. It would be easier to check the mismatched entries.
2. Sort all the 3 sheets which are Edited Portal, Matched and Mismatched in this order.
sort by GSTIN, add level Invoice Date, add level As per
Please note: Only the portal entries should be in color.
Hopefully that will be all.......
 
Upvote 0
Rich (BB code): 
wsDestination.Range("B2:M" & DestinationLastRow).Interior.Color = RGB(146, 208, 80)             ' Highlight the range green
    wsDestination.Range("B2:M" & DestinationLastRow).Font.Bold = True                               ' Make the range Bold
It is in your code for the portal sheet. I know where to fit it in but the variable must be different for the Matched and Mismatched sheets. Right.. Edited Portal sheet is already colored.
 
Upvote 0
How about this:

VBA Code: 
    Option Explicit

    Dim DestinationLastRow          As Long
    Dim DestinationRemarksColumn    As String
    Dim wsDestination               As Worksheet

Sub New_Updated()
'
'solved by JohnnyL 30-03-2022
'Updated on 04-04-2022
'Updated on 05-04-2022 11:30
'
    Application.ScreenUpdating = False                                          ' Turn ScreenUpdating off
'
    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"                                          ' <--- Set this to the name of the sheet to store the shortened Portal data into
         SourceSheet = "PORTAL"                                                 ' <--- Set this to the Portal sheet that you want data from
        MatchedSheet = "Matched"                                                ' <--- Set this to the Matched sheet that you copy matches to
     MismatchesSheet = "Mismatches"                                             ' <--- Set this to the Mismatches sheet that you copy mismatches to
'
      DestinationRemarksColumn = "J"                                            ' <--- Set this to the 'Remarks' column letter
    SourceDataLastWantedColumn = "P"                                            ' <--- Set this to the last column of wanted data on the source sheet
         SourceDataStartColumn = "A"                                            ' <--- Set this to the starting column of wanted data on the source sheet
            SourceDataStartRow = 7                                              ' <--- Set this to the starting row of data on the source sheet
'
    On Error Resume Next                                                                    ' Bypass error generated in next line if sheet does not exist
    Set wsDestination = Sheets(DestinationSheet)                                            ' Assign DestinationSheet to wsDestination
         Set wsSource = Sheets(SourceSheet)                                                 ' Assign SourceSheet to wsSource
        Set wsMatched = Sheets(MatchedSheet)                                                ' Assign MatchedSheet to wsMatched
     Set wsMismatches = Sheets(MismatchesSheet)                                             ' Assign MismatchesSheet to wsMismatches
    On Error GoTo 0                                                                         ' Turn Excel error handling back on
'
' Create DestinationSheet if it doesn't exist
    If Not wsDestination Is Nothing Then DestinationSheetExists = True                      ' Check to see if the DestinationSheet exists
    If DestinationSheetExists = False Then                                                  ' If DestinationSheet does not exist then ...
        Sheets.Add(after:=wsSource).Name = DestinationSheet                                 '   Create the DestinationSheet after the Source sheet
        Set wsDestination = Sheets(DestinationSheet)                                        '   Assign the DestinationSheet to wsDestination
    End If
'
' Create MatchedSheet if it doesn't exist
    If Not wsMatched Is Nothing Then MatchedSheetExists = True                              ' Check to see if the MatchedSheet exists
    If MatchedSheetExists = False Then                                                      ' If MatchedSheet does not exist then ...
        Sheets.Add(after:=wsSource).Name = MatchedSheet                                     '   Create the MatchedSheet after the Source sheet
        Set wsMatched = Sheets(MatchedSheet)                                                '   Assign the MatchedSheet to wsMatched
    End If
'
' Create MismatchesSheet if it doesn't exist
    If Not wsMismatches Is Nothing Then MismatchesSheetExists = True                        ' Check to see if the MismatchesSheet exists
    If MatchedSheetExists = False Then                                                      ' If MismatchesSheet does not exist then ...
        Sheets.Add(after:=wsSource).Name = MismatchesSheet                                  '   Create the MismatchesSheet after the Source sheet
        Set wsMismatches = Sheets(MismatchesSheet)                                          '   Assign the MismatchesSheet to wsMismatches
    End If
'
'---------------------------------------------------------------
'
    SourceLastRow = wsSource.Range("A" & Rows.Count).End(xlUp).Row                          ' Get last row used in column A of the source sheeet
'
    SourceArray = wsSource.Range(SourceDataStartColumn & SourceDataStartRow & _
            ":" & SourceDataLastWantedColumn & SourceLastRow)                               ' Load all needed data from source sheet to 2D 1 based SourceArray RC
'
    ReDim OutputArray(1 To UBound(SourceArray, 1), 1 To UBound(SourceArray, 2))             ' Establish # of rows/columns in 2D 1 based OutputArray
    OutputArrayRow = 0                                                                      ' Initialize OutputArrayRow
'
    For SourceArrayRow = 1 To UBound(SourceArray, 1)                                        ' Loop through all rows of SourceArray
        If Right$(Application.Trim(SourceArray(SourceArrayRow, 3)), 6) = "-Total" Then      '   If a total cell is found in the array then ...(3 represents column C)
            OutputArrayRow = OutputArrayRow + 1                                             '       Increment OutputArrayRow
'
            OutputArray(OutputArrayRow, 1) = OutputArrayRow                                 ' Row #
            OutputArray(OutputArrayRow, 2) = "PORTAL"                                       ' 'PORTAL'
'
            OutputArray(OutputArrayRow, 3) = SourceArray(SourceArrayRow, 1)                 ' GSTIN
            OutputArray(OutputArrayRow, 4) = SourceArray(SourceArrayRow, 2)                 ' Name of supplier
            OutputArray(OutputArrayRow, 5) = Replace(SourceArray(SourceArrayRow, 3), _
                    "-Total", "")                                                           ' Invoice #
            OutputArray(OutputArrayRow, 6) = SourceArray(SourceArrayRow, 5)                 ' Invoice Date
'
            OutputArray(OutputArrayRow, 7) = SourceArray(SourceArrayRow, 11)                ' Integrated Tax
            OutputArray(OutputArrayRow, 8) = SourceArray(SourceArrayRow, 12)                ' Central Tax
            OutputArray(OutputArrayRow, 9) = SourceArray(SourceArrayRow, 13)                ' State/UT Tax
'
            OutputArray(OutputArrayRow, 11) = SourceArray(SourceArrayRow, 6)                ' Invoice value
            OutputArray(OutputArrayRow, 12) = SourceArray(SourceArrayRow, 10)               ' Taxable value
            OutputArray(OutputArrayRow, 13) = SourceArray(SourceArrayRow, 16)               ' Filing Date
'
            OutputArray(OutputArrayRow, 15) = "As Per Portal"                               ' 'As Per Portal'
        End If
    Next
'
'---------------------------------------------------------------
'
    wsDestination.UsedRange.Clear                                                                   ' Delete previous contents from destination sheet
    wsMatched.UsedRange.Clear                                                                       ' Delete any previous contents from MatchedSheet
    wsMismatches.UsedRange.Clear                                                                    ' Delete any previous contents from MismatchesSheet
'
    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")                               ' Header row to paste to desired sheets
'
' Write header values into the DestinationSheet, MatchedSheet, & MismatchesSheet
    wsDestination.Range("A1:O1").Value = HeaderTitlesToPaste                                        ' Write header row to DestinationSheet
        wsMatched.Range("A1:O1").Value = HeaderTitlesToPaste                                        ' Write header row to MatchedSheet
        wsMismatches.Range("A1:O1").Value = HeaderTitlesToPaste                                     ' Write header row to MismatchesSheet
'
    wsDestination.Columns("F:F").NumberFormat = "@"                                                 ' Set column to text format to prevent excel changing dates
    wsDestination.Range("A2").Resize(UBound(OutputArray, 1), UBound(OutputArray, 2)) = OutputArray  ' Display results to DestinationSheet
'
    DestinationLastRow = wsDestination.Range("A" & wsDestination.Rows.Count).End(xlUp).Row          ' Get last row used in column A of the destination sheeet
'
    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"")"                       ' Copy Narration Formula to Column N
'
    wsDestination.Range("O2:O" & DestinationLastRow) = "As Per Portal"                              ' Copy 'As Per Portal' to Column O
    wsDestination.Range("G:I", "K:L").NumberFormat = "0.00"                                         ' Set columns to numeric with 2 decimal places
'
    wsDestination.Range("N2:N" & DestinationLastRow).Copy                                           ' Copy formula range into memory
    wsDestination.Range("N2:N" & DestinationLastRow).PasteSpecial xlPasteValues                     ' Paste just the vales back to range
    Application.CutCopyMode = False                                                                 ' Clear clipboard & 'marching ants' around copied range
'
    wsDestination.Range("F:F").NumberFormat = "dd-mm-yyyy"                                          ' Format the date the way we want it to appear
    wsDestination.Columns("F:F").TextToColumns Destination:=Range("F1"), _
            DataType:=xlDelimited, FieldInfo:=Array(1, 4)                                           ' Convert text to numeric
'
    wsDestination.Range("M:M").NumberFormat = "dd-mm-yyyy"                                          ' Format the date the way we want it to appear
    wsDestination.Columns("M:M").TextToColumns Destination:=Range("M1"), _
            DataType:=xlDelimited, FieldInfo:=Array(1, 4)                                           ' Convert text to numeric
'
    wsDestination.Range("B2:M" & DestinationLastRow).Interior.Color = RGB(146, 208, 80)             ' Highlight the range green
    wsDestination.Range("B2:M" & DestinationLastRow).Font.Bold = True                               ' Make the range Bold
'
'---------------------------------------------------------------
'
    For Each ws In Worksheets                                                                       ' Loop through all worksheets in the workbook
        Select Case ws.Name
            Case Is = SourceSheet, DestinationSheet, "Expected Result", "Matched", _
                    "Mismatches"                                                                    '       List of sheets to exclude
'               Skip these sheets
            Case Else                                                                               '       All other sheets ...
                Call GetDataFromDataSheet(ws.Name)                                                  '           Pass sheet name to the sub routine
        End Select
    Next                                                                                            ' Loop back
'
'---------------------------------------------------------------
'
    DestinationLastRow = wsDestination.Range("A" & _
            wsDestination.Rows.Count).End(xlUp).Row                                                 ' Get last row used in column A of the destination sheeet
'
    HeaderTitle = "Integrated Tax"                                                                  ' Set the header title we will look for & sort
    Call SortColumnAndApplyFormulas(HeaderTitle)                                                    ' Pass HeaderTitle to the sub routine
'
    HeaderTitle = "Central Tax"                                                                     ' Set the header title we will look for & sort
    Call SortColumnAndApplyFormulas(HeaderTitle)                                                    ' Pass HeaderTitle to the sub routine
'
    wsDestination.UsedRange.EntireColumn.AutoFit                                                    ' Autofit all of the columns on the destination Sheet
'
'---------------------------------------------------------------
'
    DestintionArray = wsDestination.Range("A2:" & SourceDataLastWantedColumn & _
            DestinationLastRow)                                                                     ' Load all needed data from destination sheet to
'                                                                                                   '   2D 1 based DestintionArray RC
    ReDim MatchedArray(1 To UBound(DestintionArray, 1), 1 To UBound(DestintionArray, 2))            ' Set the # of rows and columns for MatchedArray
    ReDim MismatchesArray(1 To UBound(DestintionArray, 1), 1 To UBound(DestintionArray, 2))         ' Set the # of rows and columns for MismatchesArray
'
    MatchedRow = 0                                                                                  ' Initialize MatchedRow
    MismatchesRow = 0                                                                               ' Initialize MismatchesRow
'
   For ArrayRow = 1 To UBound(DestintionArray, 1)                                                   ' Loop through DestintionArray rows
        On Error GoTo ErrorFound
'
        Select Case DestintionArray(ArrayRow, 10)                                                   '   Get value from column J
            Case Is = "Matched"                                                                     '       If value = 'Matched' then ...
                MatchedRow = MatchedRow + 1                                                         '           Increment MatchedRow
'
                For ArrayColumn = 1 To UBound(DestintionArray, 2)                                   '           Loop through DestintionArray columns
                    MatchedArray(MatchedRow, ArrayColumn) = DestintionArray(ArrayRow, ArrayColumn)  '               Save Destination cell to MatchedArray
                Next                                                                                '           Loop back
            Case Else
ErrorFound:
                Resume Continue                                                                     '           Clear error if it exists
Continue:
                On Error GoTo 0                                                                     '           Turn Excel error handling back on
                MismatchesRow = MismatchesRow + 1                                                   '           Increment MismatchesRow
'
                For ArrayColumn = 1 To UBound(DestintionArray, 2)                                   '           Loop through DestintionArray columns
                    MismatchesArray(MismatchesRow, ArrayColumn) = DestintionArray(ArrayRow, ArrayColumn)  '               Save Destination cell to MismatchesArray
                Next                                                                                '           Loop back
        End Select
    Next                                                                                            ' Loop back
'
    wsMatched.Range("A2").Resize(UBound(MatchedArray, 1), UBound(MatchedArray, 2)) = MatchedArray               ' Display results to Matched sheet
    wsMismatches.Range("A2").Resize(UBound(MismatchesArray, 1), UBound(MismatchesArray, 2)) = MismatchesArray   ' Display results to Mismatches sheet
'
    For Each Cel In wsMatched.Range("B2:B" & wsMatched.Range("B" & Rows.Count).End(xlUp).Row)       ' Loop through all cells in column B on the Matched sheet
        If Cel.Value = "PORTAL" Then                                                                '   If Cell value is 'PORTAL' then ...
            Cel.EntireRow.Interior.Color = RGB(146, 208, 80)                                        '       Color the row
            Cel.EntireRow.Font.Bold = True                                                          '       Bold the row
        End If
    Next                                                                                            ' Loop back
'
    For Each Cel In wsMismatches.Range("B2:B" & wsMismatches.Range("B" & Rows.Count).End(xlUp).Row) ' Loop through all cells in column B on the Mismatches sheet
        If Cel.Value = "PORTAL" Then                                                                '   If Cell value is 'PORTAL' then ...
            Cel.EntireRow.Interior.Color = RGB(146, 208, 80)                                        '       Color the row
            Cel.EntireRow.Font.Bold = True                                                          '       Bold the row
        End If
    Next                                                                                            ' Loop back
'
'   RANGE SORTER ... Most important column to least important column 3,6,2
    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                          ' Sort the destination sheet by various columns
'
'   RANGE SORTER ... Most important column to least important column 3,6,2
    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                              ' Sort the Matched sheet by various columns
'
'   RANGE SORTER ... Most important column to least important column 3,6,2
    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                           ' Sort the Mismatches sheet by various columns
'
    wsMatched.UsedRange.EntireColumn.AutoFit                                                        ' Autofit all of the columns on the MatchedSheet
    wsMismatches.UsedRange.EntireColumn.AutoFit                                                     ' Autofit all of the columns on the MismatchesSheet
'
    Application.ScreenUpdating = True                                                               ' Turn ScreenUpdating back on
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                                         ' Get last row of the Data sheet column B
'
    DataLastColumn = Split(Cells(1, (Sheets(DataWorkSheet).Cells.Find("*", _
            , xlFormulas, , xlByColumns, xlPrevious).Column)).Address, "$")(1)                      ' Get last column letter of the Data sheet
'
    Sheets(DataWorkSheet).Range("C2:C" & DataLastRow) = "As Per " & DataWorkSheet                   ' Copy 'AS PER ' & sheet name to Column C of the sheet
'
    DataSheetArray = Sheets(DataWorkSheet).Range("A2:" & _
            DataLastColumn & DataLastRow)                                                           ' Load Data from Data sheet to 2D 1 based DataSheetArray
'
    ReDim CorrectedDataArray(1 To UBound(DataSheetArray, 1), _
            1 To UBound(DataSheetArray, 2) - 2)                                                     ' Set the number of rows & columns for the CorrectedDataArray
'
    CorrectedColumn = 0                                                                             ' Initialize CorrectedColumn
'
    For ArrayRow = 1 To UBound(DataSheetArray, 1)                                                   ' Loop through the rows of DataSheetArray
        For ArrayColumn = 2 To UBound(DataSheetArray, 2)                                            '   Loop through the columns of DataSheetArray
            Select Case ArrayColumn
                Case 3: ' Skip this Column
                Case Else
                    CorrectedColumn = CorrectedColumn + 1                                           '       Increment CorrectedColumn
'
                    CorrectedDataArray(ArrayRow, CorrectedColumn) = _
                            DataSheetArray(ArrayRow, ArrayColumn)                                   '       Save DataSheetArray data into CorrectedDataArray
            End Select
        Next                                                                                        '   Loop back
'
        CorrectedColumn = 0                                                                         '   Reset CorrectedColumn
    Next                                                                                            ' Loop back
'
    DestinationStartRow = DestinationLastRow + 1                                                    ' Save DestinationLastRow + 1 into DestinationStartRow
'
    wsDestination.Range("B" & DestinationStartRow).Resize(UBound(CorrectedDataArray, _
            1), UBound(CorrectedDataArray, 2)) = CorrectedDataArray                                 ' Display Results to destination sheet
'
    DestinationLastRow = wsDestination.Range("B" & _
            wsDestination.Rows.Count).End(xlUp).Row                                                 ' Recalculate last row used in column B of the destination sheeet
'
    wsDestination.Range("O" & DestinationStartRow & ":O" & _
            DestinationLastRow) = DataSheetArray(1, 3)                                              ' Copy 'As Per ????' to Column O
'
    wsDestination.Range("A" & DestinationStartRow & _
            ":A" & DestinationLastRow).Formula = "=Row() - 1"                                       ' Use formula to set row #s
    wsDestination.Range("A" & DestinationStartRow & ":A" & DestinationLastRow).Copy                 ' Copy formula range into memory
    wsDestination.Range("A" & DestinationStartRow & ":A" & _
            DestinationLastRow).PasteSpecial xlPasteValues                                          ' Paste just the vales back to range
    Application.CutCopyMode = False                                                                 ' Clear clipboard & 'marching ants' around copied range
End Sub


Sub SortColumnAndApplyFormulas(HeaderTitle As String)
'
    Dim ColumnFirstZeroValueRow     As Long
    Dim DSCol                       As String       ' DestinationSortColumn
    Dim FormulaReplacementString1   As String
'
    DSCol = Split(Cells(1, wsDestination.Range("1:1").Find(HeaderTitle).Column).Address, "$")(1)        ' Find Column letter of the HeaderTitle we are looking for
'
'   RANGE SORTER ... Least important column to most important column 7
    wsDestination.Range("A2:O" & DestinationLastRow). _
            Sort Key1:=wsDestination.Range(DSCol & "2"), Order1:=xlDescending, Header:=xlNo             ' Sort HeaderTitle Column highest to lowest
'
    ColumnFirstZeroValueRow = wsDestination.Range(DSCol & "1:" & DSCol & wsDestination.Range("A" & _
            Rows.Count).End(xlUp).Row).Find(what:=0, LookAt:=xlWhole, SearchDirection:=xlNext).Row      ' Locate first row in column with a zero value
'
    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)))"     ' Additional string to insert into formula
'
    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())"                                                              '   Formula to insert into 'Remarks' column
        .Replace "xxxxxx", FormulaReplacementString1, xlPart                                            '   Insert additional string into formula
    End With
'
    wsDestination.Range(DestinationRemarksColumn & "2").AutoFill wsDestination.Range(DestinationRemarksColumn & _
            "2:" & DestinationRemarksColumn & ColumnFirstZeroValueRow - 1)                              ' Drag the formula down till zero value is found
'
    wsDestination.Range(DestinationRemarksColumn & "2:" & DestinationRemarksColumn & _
            ColumnFirstZeroValueRow - 1).Copy                                                           ' Copy formula range into memory
    wsDestination.Range(DestinationRemarksColumn & "2:" & DestinationRemarksColumn & _
            ColumnFirstZeroValueRow - 1).PasteSpecial xlPasteValues                                     ' Paste just the vales back to range
    Application.CutCopyMode = False                                                                     ' Clear clipboard & 'marching ants' around copied range
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

RAJESH1960
  • Solved
Match value which is a part of a whole value
Replies
3
Views
620
cmowla
C
RAJESH1960
  • Solved
Replace old formula with new one in the code.
2 3 4
Replies
30
Views
2K
RAJESH1960
RAJESH1960
J
  • Solved
VBA array formula gives error 1004 Unable to set the FormulaArray property of the Range class
2
Replies
14
Views
3K
johnnyL
J
Burrgogi
  • Question Question
Need some help with VBA - evaluating a string of numbers and from VLOOKUP routine.
Replies
2
Views
102
StephenCrump
S
D
  • Solved
VBA to generate report
2
Replies
15
Views
307
dsubash
D

Share this page

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