Add level to sort data in code

RAJESH SHAH · Dec 4th 2022

Hello experts

I am facing a very weird problem. I have this code which is running fine and giving the correct result. I just want to add a level to sort the data in the code. The weird part is that the old code is working fine but after adding another level to sort it is wiping out the whole data. I need your expertise to help me to help me find and correct the issue.

Code

 Range("A2:" & LastColumn & Range("A" & Rows.Count).End(xlUp).Row).Sort _
            Key1:=Range(DestinationRemarksColumn & "2"), Order1:=xlAscending, Header:=xlNo                          ' Sort Remarks Column lowest to highest

This code has one level to sort and is working correct.

Code

Range("A2:" & LastColumn & Range("A" & Rows.Count).End(xlUp).Row).Sort _
            Key1:=Range("C2"), Order1:=xlAscending, _
            Key2:=Range(DestinationRemarksColumn & "2"), Order1:=xlAscending, Header:=xlNo

After replacing the above lines with the below lines the code is wiping the data.

Weird as it sounds but this is the issue I am facing.

to add level to sort.xlsm

**Carim** · Dec 4th 2022

Hello,

With Key1 you have Order1 .... but with Key2, you should have Order2 ...

Hope this will help

RAJESH SHAH · Dec 4th 2022

Quote from Carim

Hello,

With Key1 you have Order1 .... but with Key2, you should have Order2 ...

Hope this will help

I replaced Order1 to order2 but it is still deleting the whole data.

If you comment the 3 new added lines and uncomment the 2 commented lines then the code is running correct and not deleting the data.

**Carim** · Dec 4th 2022

Sorry but in order to test your file would need to need which macro in which module .... and which worksheet you are referring to ...

RAJESH SHAH · Dec 4th 2022

The "A4_Copy_Rename_MatchedSheet" module is sorting the data. The sheet created by the code "to correct Invoice No. & Date" is the sheet to be sorted with an additional level.

RAJESH SHAH · Dec 4th 2022

Once the code has finished displaying the result, I can manually sort the data in "to correct Invoice No. & Date" sheet and get the correct result. But I want to include those steps in the code.

Code

Option Explicit

Sub Macro1()
'
' Macro1 Macro
'

'
    Sheets("to correct Invoice No. & Date").Select
    Range("D2").Select
    ActiveWorkbook.Worksheets("to correct Invoice No. & Date").Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("to correct Invoice No. & Date").Sort.SortFields. _
        Add2 key:=Range("C2:C1160"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("to correct Invoice No. & Date").Sort.SortFields. _
        Add2 key:=Range("K2:K1160"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("to correct Invoice No. & Date").Sort
        .SetRange Range("A1:N1160")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Display More

**Carim** · Dec 4th 2022

Hello again,

Just tested your workbook and the sort macro which does operate fine ...

Your problem is created to the instruction which follows :

Code

Rows(FirstMatch & ":" & LastRow).Delete

Just comment it out .... and everything looks fine ...

holycow · Dec 4th 2022

Modified your code as follows:-

Code

Private Sub A4_Copy_Rename_MatchedSheet()
'
Dim StartTime   As Double
StartTime = Timer                                                                           ' Start the stop watch
'
Dim FirstMatch                  As Long
Dim DestinationRemarksColumn    As String
Dim LastColumn                  As String
'
DestinationRemarksColumn = "K"                                                                                  ' <--- Set this to the 'Remarks' column letter
'
Sheets("Matched").Copy After:=Sheets(Sheets.Count)                                                              ' Copy/add worksheet


ActiveSheet.Name = "to correct Invoice No. & Date"                                                              ' Rename the new sheet
'
LastRow = Range("A" & Rows.Count).End(xlUp).Row                                                                 ' Get LastRow used of new sheet
LastColumn = Split(Cells(Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column).Address, "$")(1)   ' LastColumn Letter Used In Sheet
'
With Range(DestinationRemarksColumn & "2:" & DestinationRemarksColumn & LastRow)
.Formula = "=IF(COUNTIFS($C$2:$C$" & LastRow & ",$C2,$B$2:$B$" & LastRow & ",""<>""&$B2,$E$2:$E$" & _
LastRow & ",$E2)=0,""Invoice No. Mismatch"","""")&IF(COUNTIFS($C$2:$C$" & LastRow & _
",$C2,$B$2:$B$" & LastRow & ",""<>""&$B2,$F$2:$F$" & LastRow & ",$F2)=0,""Date Mismatch"","""")" & _
"&IF(COUNTIFS($C$2:$C$" & LastRow & ",$C2,$B$2:$B$" & LastRow & ",""<>""&$B2,$E$2:$E$" & _
LastRow & ",$E2,$F$2:$F$" & LastRow & ",$F2)>0,""zzz"","""")"                                   '   Formula to write to the range
.Copy                                                                                                       '   Copy the formula range


.PasteSpecial xlPasteValues                                                                                 '   Paste just the values back to range


Application.CutCopyMode = False                                                                             '   Clear clipboard & 'marching ants' around copied range
End With
'
Range(DestinationRemarksColumn & "1").EntireColumn.AutoFit                                                      ' Adjust the width of the DestinationRemarksColumn
'
'    Range("A2:" & LastColumn & Range("A" & Rows.Count).End(xlUp).Row).Sort _
'            Key1:=Range(DestinationRemarksColumn & "2"), Order1:=xlAscending, Header:=xlNo                          ' Sort Remarks Column lowest to highest
Range("A2:" & LastColumn & Range("A" & Rows.Count).End(xlUp).Row).Sort _
Key1:=Range(DestinationRemarksColumn & "2"), Order1:=xlAscending, _
Key2:=Range("C2"), Order1:=xlAscending, Header:=xlNo                          ' Sort GSTIN then Invoice Column lowest to highest
'
FirstMatch = Columns(DestinationRemarksColumn).Find(what:="zzz", After:=Range(DestinationRemarksColumn & "1")).Row  ' Find first cell in DestinationRemarksColumn that = 'Matched
'
Rows(FirstMatch & ":" & LastRow).Delete                                                                         ' Ddelete the 'Matched' rows
'
Debug.Print "Copy_Rename_MatchedSheet completed in " & Timer - StartTime & " seconds."
'
End Sub

Display More

holycow · Dec 4th 2022

Here is a shorter version of your macro

Code

Sub temp()
Dim rng As Range, r As Long, c As Long, z As Long
Sheets("Matched").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = "to correct Invoice No. & Date"
r = [a1].CurrentRegion.Rows.Count - 1: c = [a1].CurrentRegion.Columns.Count
Set rng = [a2].Resize(r, c)
r = r + 1
With rng
With .Columns(11)
.Value = "=IF(COUNTIFS($C$2:$C$" & r & ",$C2,$B$2:$B$" & r & ",""<>""&$B2,$E$2:$E$" & _
r & ",$E2)=0,""Invoice No. Mismatch"","""")&IF(COUNTIFS($C$2:$C$" & r & _
",$C2,$B$2:$B$" & r & ",""<>""&$B2,$F$2:$F$" & r & ",$F2)=0,""Date Mismatch"","""")" & _
"&IF(COUNTIFS($C$2:$C$" & r & ",$C2,$B$2:$B$" & r & ",""<>""&$B2,$E$2:$E$" & _
r & ",$E2,$F$2:$F$" & r & ",$F2)>0,""zzz"","""")"
.Value = .Value
.AutoFit
End With
.Sort Key1:=.Columns(11), Order1:=xlAscending, Key2:=.Columns(3), Order2:=xlAscending, Orientation:=xlSortColumns
z = .Columns(11).Find("zzz").Row
End With
Rows(z & ":" & r).Delete
End Sub

Display More

RAJESH SHAH · Dec 4th 2022

Thanks HolyCow. The shorter version is working and giving me the expected result. Without comments I am completely lost. If you could PLEASE edit and correct my code I would really appreciate it.

RAJESH SHAH · Dec 5th 2022

Quote from Carim
Hello again,

Just tested your workbook and the sort macro which does operate fine ...

Your problem is created to the instruction which follows :
Code
Rows(FirstMatch & ":" & LastRow).Delete
Just comment it out .... and everything looks fine ...
Display More

Thanks Carim. But I have to delete the Matched rows in column Invoice value to know which all transactions need to be corrected. Now that the problem is resolved, thanks a lot for your support.

**Carim** · Dec 5th 2022

Pleased to hear it is all sorted out

Add level to sort data in code

RAJESH SHAH Dec 5th 2022

Participate now!

Share

Similar Threads

Copy Data by month to table using Inputbox with Add or Delete Row

add autosum function in each new sheet

Code to automatically sort data

Code overwriting data on paste problem

Copying data from a specific folder to a master workbook and then plotting the data

sort entire row based on column contain three parts of digits, letter for each category

Users Viewing This Thread