Code to post selected headings with selected data to another sheet in fixed order

[RAJESH1960]

Hello guys

In the workbook shared in the link, PORTAL is a merged sheet with lot of columns not required. The headings are in the same order always. I copied only the required Headings of sheet Portal to Edited Portal, in the order as shown in Edited Portal which are entered manually with a few extra headings in some columns . I have copied the bold fonts rows from each column in Portal to Edited Portal in regular fonts. I removed the “-Total” from the invoice number in Edited Portal. The columns with the amount values are converted to number format with 2 decimal places. The invoice date is changed to dd-mm-yyyy format. And finally, the columns Line and As Per are filled from 2nd row to the last cell with value, as shown. This drill is the same in all cases and it takes hours to do this. So, I thought a code will definitely help me to do the above in seconds.
Loading Google Sheets

 

[johnnyL]

Once again, your dates create an issue. You should probably address that issue with the staff.

But here is the rest of the code to handle your wishes...

Sub Test1()
'
    Dim DestinationSheetExists      As Boolean
    Dim OutputArrayRow              As Long, SourceArrayRow             As Long
    Dim SourceDataStartRow          As Long, SourceLastRow              As Long
    Dim SourceDataLastWantedColumn  As String, SourceDataStartColumn    As String
    Dim OutputArray                 As Variant, SourceArray             As Variant
    Dim wsDestination               As Worksheet, wsSource              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 = "M"                            ' <--- 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
'
'---------------------------------------------------------------
'
' Write all header values into the DestinationSheet
    wsDestination.Range("A1:M1").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", "Data from")                                               ' Write header row to DestinationSheet
'
    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 from source sheet to 2D 1 based SourceArray RC
'
''Debug.Print UBound(SourceArray, 1)  ' 307
''Debug.Print SourceArray(307, 3)
'
    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 ...
            OutputArrayRow = OutputArrayRow + 1                                         '       Increment OutputArrayRow
'
            OutputArray(OutputArrayRow, 1) = OutputArrayRow
            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) = "PORTAL"
        End If
    Next
'
    wsDestination.Range("A2").Resize(UBound(OutputArray, 1), UBound(OutputArray, 2)) = OutputArray  ' Display results to DestinationSheet
'
    wsDestination.Range("G:I").NumberFormat = "0.00"
    wsDestination.Range("K:L").NumberFormat = "0.00"
'
wsDestination.Range("F:F").NumberFormat = "dd-mm-yyyy"
'
    wsDestination.UsedRange.EntireColumn.AutoFit                '   Autofit all of the columns on the DestinationSheet
End Sub

 

[johnnyL]

You may want to start a separate thread just for the Date issue that you always seem to encounter. I handled it previously in previous code of yours because you offered a .CSV file, but this situation is different.

 

[RAJESH1960]

your dates create an issue

The data is exported from a software and by default the date is displayed like that. What I do is, in the edited sheet, I do it manually. I insert a column next to invoice date with the same heading and then with a formula, = value in the first cell below the heading and drag it down to the last cell and again select and format it to short date. (dd-mm-yyyy),
In the code, I am getting a compile error in this line...

 DestinationSheet = "Edited Portal"                          ' <--- Set this to the name of the sheet to store the shortened Portal data into

I tried defining the variable as

Dim DestinationSheet As Variant

hope it is okay.
Regarding the date, I am not able to sort it as the date format is as you said is a problem. If you can correct it in the code itself, the way I do it, it would be great and I don't have to do it manually. Otherwise, it is perfect.

 

[johnnyL]

How about:

Sub Test2()
'
    Dim DestinationSheetExists      As Boolean
    Dim OutputArrayRow              As Long, SourceArrayRow             As Long
    Dim SourceDataStartRow          As Long, SourceLastRow              As Long
    Dim DestinationSheet            As String
    Dim SourceDataLastWantedColumn  As String, SourceDataStartColumn    As String
    Dim OutputArray                 As Variant, SourceArray             As Variant
    Dim wsDestination               As Worksheet, wsSource              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 = "M"                            ' <--- 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
'
'---------------------------------------------------------------
'
' Write all header values into the DestinationSheet
    wsDestination.Range("A1:M1").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", "Data from")                                               ' Write header row to DestinationSheet
'
    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 from source sheet to 2D 1 based SourceArray RC
'
''Debug.Print UBound(SourceArray, 1)  ' 307
''Debug.Print SourceArray(307, 3)
'
    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 ...
            OutputArrayRow = OutputArrayRow + 1                                         '       Increment OutputArrayRow
'
            OutputArray(OutputArrayRow, 1) = OutputArrayRow
            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) = "PORTAL"
        End If
    Next
'
    wsDestination.Columns("F:F").NumberFormat = "@"
    wsDestination.Range("A2").Resize(UBound(OutputArray, 1), UBound(OutputArray, 2)) = OutputArray  ' Display results to DestinationSheet
'
    wsDestination.Range("G:I").NumberFormat = "0.00"
    wsDestination.Range("K:L").NumberFormat = "0.00"
'
    wsDestination.Range("F:F").NumberFormat = "dd-mm-yyyy"
'
    wsDestination.UsedRange.EntireColumn.AutoFit                '   Autofit all of the columns on the DestinationSheet
End Sub

 

[RAJESH1960]

I am facing another problem. When I tested it on a new original data, only the headings are copied. The data below the headings is blank. Trying to figure it out what is wrong.? Once I figure it out will come back to you.
With the new code, still I am not able to sort by date. I am getting a warning message...
The following sort key may not sort as expected because it contains some numbers formatted as text invoice date.
Then I have to select "Sort anything that looks like a number, as a number."

 

[RAJESH1960]

Sorry. Found my mistake. Now it is good except for the date format.

 

[johnnyL]

? the dates are dd-mm-yyyy as requested.

 

[RAJESH1960]

Regarding the date I am sharing the recorded macro code to format the date. You can just change the range to the count of last row with value.

Option Explicit

Sub Macro1()

    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight
    Range("F1").Select
    Selection.Copy
    Range("G1").Select
    ActiveSheet.Paste
    Range("G2").Select
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=VALUE(RC[-1])"
    Range("G2").Select
    Selection.AutoFill Destination:=Range("G2:G102")
    Range("G2:G102").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "m/d/yyyy"
    Columns("F:F").Select
    Selection.Delete Shift:=xlToLeft
    Range("F2").Select
End Sub

After doing the above, I am able to sort the data by date without any warning.

 

[RAJESH1960]

? the dates are dd-mm-yyyy as requested.

They are, but not date format. They are stored as numbers I think. That is why I am not able to sort them.