Dear Excel users.
I have come across a code from the book Excel 2016 VBA and Macros (MrExcel Library). The code is written by Zack Barresse and is about Copying Data to Separate Worksheets Without using Filter.
The code is the following :
There are two lines I do not understand :
What is the purpose of those lines ? I commented them and the code failed. I commented only "SortColumn.DataBodyRange.Value = SortColumn.DataBodyRange.Value" and the code worked. The line "CriteriaColumn.DataBodyRange.Value = CriteriaColumn.DataBodyRange.Value" seems to be critical. I do not understand why we set something like "A=A".
Thank you for your help
Best regards,
Stan
I have come across a code from the book Excel 2016 VBA and Macros (MrExcel Library). The code is written by Zack Barresse and is about Copying Data to Separate Worksheets Without using Filter.
The code is the following :
VBA Code:
Sub CriteriaRange_Copy()
Dim Table As ListObject
Dim SortColumn As ListColumn
Dim CriteriaColumn As ListColumn
Dim FoundRange As Range
Dim TargetSheet As Worksheet
Dim HeaderVisible As Boolean
Set Table = ActiveSheet.ListObjects(1) ' Set as desired
HeaderVisible = Table.ShowHeaders
Table.ShowHeaders = True
On Error GoTo RemoveColumns
Set SortColumn = Table.ListColumns.Add(Table.ListColumns.Count + 1)
Set CriteriaColumn = Table.ListColumns.Add(Table.ListColumns.Count + 1)
On Error GoTo 0
'Add a column to keep track of the original order of the records
SortColumn.Name = " Sort"
CriteriaColumn.Name = " Criteria"
SortColumn.DataBodyRange.Formula = "=ROW(A1)"
SortColumn.DataBodyRange.Value = SortColumn.DataBodyRange.Value
CriteriaColumn.DataBodyRange.Formula = "=1/(([@Units]<10)*([@Cost]<10))"
CriteriaColumn.DataBodyRange.Value = CriteriaColumn.DataBodyRange.Value
Table.Range.Sort Key1:=CriteriaColumn.Range(1, 1), Order1:=xlAscending, Header:=xlYes
On Error Resume Next
Set FoundRange = Intersect(Table.Range, CriteriaColumn.DataBodyRange.SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow)
On Error GoTo 0
If Not FoundRange Is Nothing Then
Set TargetSheet = ThisWorkbook.Worksheets.Add(After:=ActiveSheet)
FoundRange(1, 1).Offset(-1, 0).Resize(FoundRange.Rows.Count + 1, FoundRange.Columns.Count - 2).Copy
TargetSheet.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
End If
Table.Range.Sort Key1:=SortColumn.Range(1, 1), Order1:=xlAscending, Header:=xlYes
RemoveColumns:
If Not SortColumn Is Nothing Then SortColumn.Delete
If Not CriteriaColumn Is Nothing Then CriteriaColumn.Delete
Table.ShowHeaders = HeaderVisible
End Sub
There are two lines I do not understand :
SortColumn.DataBodyRange.Value = SortColumn.DataBodyRange.Value
CriteriaColumn.DataBodyRange.Value = CriteriaColumn.DataBodyRange.Value
What is the purpose of those lines ? I commented them and the code failed. I commented only "SortColumn.DataBodyRange.Value = SortColumn.DataBodyRange.Value" and the code worked. The line "CriteriaColumn.DataBodyRange.Value = CriteriaColumn.DataBodyRange.Value" seems to be critical. I do not understand why we set something like "A=A".
Thank you for your help
Best regards,
Stan