Prev: I learn that way
Next: VBA//Oracle Interfacing Question
From: OssieMac on 16 Nov 2009 00:18
The following should do what you want. I have actually now added 2 columns of
temporary data. Column G now contains the date and money concatenated into
one field. The CountIf is then applied to that field in the next column H.
All of this is done within the code.

It handles a situation of no records meeting the delete criteria.

As before, backup your data before running the code in case it does not do
as expected.

Note that a space and underscore at the end of a line is a line break in an
otherwise single line of code. When applied to lines with double quotes, the
double quotes are closed off, an ampersand inserted and the double quotes
opened again.


Sub DeleteAutoFilteredRows()
Dim lngRows As Long
Dim rngDelete As Range

'Edit 'Sheet1" to your sheet name
With Sheets("Sheet1")
lngRows = .Cells(.Rows.Count, "E").End(xlUp).Row
.Range("G1") = "Concat Date and Cost"
.Range("H1") = "Counts"

.Range("G2").Formula = _
"=TEXT(B2,""dd/mm/yyyy"") & " & _
""" "" & TEXT(E2,""0.00"")"

.Range("G2").Copy _
Destination:=.Range("G2:G" & lngRows)

.Range("H2").Formula = _
"=COUNTIF($G:$G,G2)"

.Range("H2").Copy _
Destination:=.Range("H2:H" & lngRows)

.Range("H2:H11").NumberFormat = "#,##0"
.Columns("G:H").Columns.AutoFit

'Turn off autofilter if already on
'and reset to on with all columns of data
.AutoFilterMode = False
.Range("A1:H" & lngRows).AutoFilter

.Range("$A$1:$H$" & lngRows).AutoFilter _
Field:=8, Criteria1:="1"


'Assign filtered data to range variable.
'Offset excludes column headers.
'Resize reduces by one row because offset _
includes an extra blank row at bottom.
With .AutoFilter.Range
On Error Resume Next 'In case no rows visible
Set rngDelete = .Offset(1, 0) _
.Resize(.Rows.Count - 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0 'Reset error trapping ASAP.
If rngDelete Is Nothing Then
MsgBox "No records with count 1." & _
vbCrLf & "Processing terminated."
GoTo SkipDelete
End If
End With

'Remove comment (') from following _
line if you want to view before _
data is deleted during testing
'Exit Sub

'Delete the filtered data
rngDelete.EntireRow.Delete

SkipDelete:
.ShowAllData

'Turn off autofilter
.AutoFilterMode = False

'Clear temporary columns of data
.Columns("G:H").Clear

End With

End Sub




--
Regards,

OssieMac


From: 1plane on 16 Nov 2009 08:04
On Nov 16, 5:18 am, OssieMac <Ossie...(a)discussions.microsoft.com>
wrote:
> The following should do what you want. I have actually now added 2 columns of
> temporary data. Column G now contains the date and money concatenated into
> one field. The CountIf is then applied to that field in the next column H..
> All of this is done within the code.
>
> It handles a situation of no records meeting the delete criteria.
>
> As before, backup your data before running the code in case it does not do
> as expected.
>
> Note that a space and underscore at the end of a line is a line break in an
> otherwise single line of code. When applied to lines with double quotes, the
> double quotes are closed off, an ampersand inserted and the double quotes
> opened again.
>
> Sub DeleteAutoFilteredRows()
> Dim lngRows As Long
> Dim rngDelete As Range
>
> 'Edit 'Sheet1" to your sheet name
> With Sheets("Sheet1")
>   lngRows = .Cells(.Rows.Count, "E").End(xlUp).Row
>   .Range("G1") = "Concat Date and Cost"
>   .Range("H1") = "Counts"
>
>   .Range("G2").Formula = _
>     "=TEXT(B2,""dd/mm/yyyy"") & " & _
>     """ "" & TEXT(E2,""0.00"")"
>
>   .Range("G2").Copy _
>     Destination:=.Range("G2:G" & lngRows)
>
>   .Range("H2").Formula = _
>     "=COUNTIF($G:$G,G2)"
>
>   .Range("H2").Copy _
>     Destination:=.Range("H2:H" & lngRows)
>
>   .Range("H2:H11").NumberFormat = "#,##0"
>   .Columns("G:H").Columns.AutoFit
>
>   'Turn off autofilter if already on
>   'and reset to on with all columns of data
>   .AutoFilterMode = False
>   .Range("A1:H" & lngRows).AutoFilter
>
>   .Range("$A$1:$H$" & lngRows).AutoFilter _
>     Field:=8, Criteria1:="1"
>
>   'Assign filtered data to range variable.
>   'Offset excludes column headers.
>   'Resize reduces by one row because offset _
>    includes an extra blank row at bottom.
>   With .AutoFilter.Range
>     On Error Resume Next  'In case no rows visible
>     Set rngDelete = .Offset(1, 0) _
>       .Resize(.Rows.Count - 1) _
>       .SpecialCells(xlCellTypeVisible)
>     On Error GoTo 0 'Reset error trapping ASAP.
>     If rngDelete Is Nothing Then
>       MsgBox "No records with count 1." & _
>         vbCrLf & "Processing terminated."
>       GoTo SkipDelete
>     End If
>   End With
>
>   'Remove comment (') from following _
>    line if you want to view before _
>    data is deleted during testing
>   'Exit Sub
>
>   'Delete the filtered data
>   rngDelete.EntireRow.Delete
>
> SkipDelete:
>   .ShowAllData
>
>   'Turn off autofilter
>   .AutoFilterMode = False
>
>   'Clear temporary columns of data
>   .Columns("G:H").Clear
>
> End With
>
> End Sub
>
> --
> Regards,
>
> OssieMac

Dear OssieMac,

Thanks a million for your assistance.

I hope some day I can help others to this degree.

Kind Regards

1plane
First  |  Prev  | 
Pages: 1 2 3
Prev: I learn that way
Next: VBA//Oracle Interfacing Question