Option Explicit
Dim DestinationLastRow As Long
Dim wsDestination As Worksheet
Sub EditPortal()
'
'solved by JohnnyL 30-03-2022
'Updated on 02-04-2022
'UPDATED ON 03-04-2022
'
Dim DestinationSheetExists As Boolean
Dim ArrayColumn As Long, ArrayRow As Long
Dim CorrectedColumn As Long
Dim OutputArrayRow As Long, SourceArrayRow As Long
Dim SourceDataStartRow As Long, SourceLastRow As Long
Dim DataWorkSheet As String, DestinationSheet As String
Dim SourceDataLastWantedColumn As String, SourceDataStartColumn As String
Dim OutputArray As Variant, SourceArray As Variant
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
Set wsSource = Sheets("PORTAL") ' <--- Set this to the Portal sheet that you want data from
'
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
On Error GoTo 0 ' Turn Excel error handling back on
'
If Not wsDestination Is Nothing Then DestinationSheetExists = True ' Check to see if the DestinationSheet exists
'
' Create DestinationSheet if it doesn't exist
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
'
'---------------------------------------------------------------
'
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"
'
OutputArray(OutputArrayRow, 3) = SourceArray(SourceArrayRow, 1) ' GSTIN
OutputArray(OutputArrayRow, 4) = SourceArray(SourceArrayRow, 2) ' Name of supplier
'
OutputArray(OutputArrayRow, 5) = Left$(SourceArray(SourceArrayRow, 3), Len(SourceArray(SourceArrayRow, 3)) - 6) ' 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"
End If
Next
'
'---------------------------------------------------------------
'
wsDestination.UsedRange.Clear ' Delete previous contents from destination sheet
'
' Write all header values into the DestinationSheet
wsDestination.Range("A1:O1").Value = 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") ' Write header row to DestinationSheet
'
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
If ws.Name <> "PORTAL" And ws.Name <> "Expected Result" And _
ws.Name <> "Edited Portal" Then ' If sheet name is not excluded then
Call GetDataFromDataSheet(ws.Name) ' Pass sheet name to the sub routine
End If
Next ' Loop back
'
wsDestination.UsedRange.EntireColumn.AutoFit ' Autofit all of the columns on the DestinationSheet
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
If ArrayColumn = 3 Then GoTo NextColumn ' Skip the 3rd column, we don't need it right now
'
CorrectedColumn = CorrectedColumn + 1 ' Increment CorrectedColumn
'
CorrectedDataArray(ArrayRow, CorrectedColumn) = _
DataSheetArray(ArrayRow, ArrayColumn) ' Save DataSheetArray data into CorrectedDataArray
NextColumn:
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