Deleting sorted cells

[brightyoyo]

Hi I am looking for a macro that will take my data, sort it (True or False) and then delete all the false results.

I have supplied sample data and sample results


https://www.dropbox.com/sh/67unlewr92vgm3z/XAGscYaB7G


Thank You

 

[Hui]

Brightyoyo


Have a look at this code:

[pre]

Sub Delete_False_Rows()

Dim x As Integer

'Sort Columns A-D
ActiveWorkbook.Worksheets("706978-02").Sort.SortFields.Clear
With ActiveWorkbook.Worksheets("706978-02").Sort
.SetRange Range("A:D")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'Delete rows
For x = Range("D1:D" & Range("D" & Rows.Count).End(xlUp).Row).Rows.Count + 1 To 1 Step -1
If Not Cells(x, 4).Value Then Cells(x, 4).EntireRow.Delete Shift:=xlUp
Next x

End Sub

[/pre]

 

[brightyoyo]

Hi Hui that worked perfectly. However, is there a way to insert the formula


=AND(LEN(B1)>=2,IF(ISNUMBER(1*MID(B1,2,1))=TRUE,ISNUMBER(1*MID(B1,2,1)),ISNUMBER(1*MID(B1,3,1)))) (from Luke M and Faseeh)


to create the true/false column and insert it into your sort and delete macro.


Thanks

 

[Hui]

Brightyoyo


You need a few extra lines of VBA like:

[pre]

'Add Formula
Range("D1").FormulaR1C1 = _
"=AND(LEN(RC[-2])>=2,IF(ISNUMBER(1*MID(RC[-2],2,1))=TRUE,ISNUMBER(1*MID(RC[-2],2,1)),ISNUMBER(1*MID(RC[-2],3,1))))"
Range("D1").Copy Destination:=Range(Range("D1"), Range("D1").End(xlDown))
Application.CutCopyMode = False

[/pre]
I have added the code to your file to add the Formula

It adds the formula before the sort which is what I think you need to do

As the file has a macro it is now saved as an *.xlsm filetype

Refer: https://www.dropbox.com/s/tw068zj9zhe946u/Initial%20Data_2.xlsm

 

[Hui]

Brightyoyo


Also changing these two lines as shown below will allow the code to run on the active sheet, not just on sheet 706978-02 as I am sure that name changes from time to time

[pre]

'Sort Columns A-D
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
With ActiveWorkbook.ActiveSheet.Sort

[/pre]

 

[brightyoyo]

Hi Hui, is there any way to make column D only fill in false for same about of cells that are in column B, instead of all the way down to the end. The number of cells in Column B will very depending on my data and the macro has a problem when the False go all the way to the bottom.


Thanks

 

[Hui]

Change the code to this:

This bases column D on Column A which seems to be the complete set of data

[pre]

Sub Delete_False_Rows()

Dim x As Integer
Dim C As Range

'Add Formula
For Each C In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
C.Offset(, 3).FormulaR1C1 = _
"=AND(LEN(RC[-2])>=2,IF(ISNUMBER(1*MID(RC[-2],2,1))=TRUE,ISNUMBER(1*MID(RC[-2],2,1)),ISNUMBER(1*MID(RC[-2],3,1))))"
Next C

'Sort Columns A-D
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Range("A:D")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'Delete rows
For x = Range("D1:D" & Range("D" & Rows.Count).End(xlUp).Row).Rows.Count + 1 To 1 Step -1
If Not Cells(x, 4).Value Then Cells(x, 4).EntireRow.Delete Shift:=xlUp
Next x

End Sub

[/pre]

or download the new file here: https://www.dropbox.com/s/qtcun53gzf8b4nj/Initial%20Data_3.xlsm

 

[brightyoyo]

Thanks Hui it worked perfectly.