Adjustmant To VBA using AdvancedFilter

  • Thread starter Thread starter mpb1
  • Start date Start date
M

mpb1

Good evening All
I am hoping that someone will be able to help with this.
I have some small VBA code (shown below), which applies to the following example of a data set:

Worksheet "Invoice Record"
A B C
1 M100 152.34 03
2 M101 100.02 NP
3 M100 250.65 02
4 M100 565.52 01
5 M102 745.87 NP
6 M101 985.65 03

Column A is Formatted Text, B Number, C Text. (Though columns A & C are flexible to other formats)

The code describes:- from column A copy unique values only to another location (another Worksheet ("General Report") in this case)
This works well, however I would really like the code to look at only the cells in column A that do not have NP as it's corresponding entry in Column C.
ie to ignore rows with NP in column C

I do hope that this is an easy fix, I am a novice at VBA but am learning! (Especially with help from this group)
Here Is the Code:

Sub ECRGeneralReportPopulation()
' Automates The General Report Population

Application.Interactive = False
Dim myRng As Range
Sheets("General Report").Range("A:A").ClearContents
With Sheets("Invoice Record")
Set myRng = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
End With
myRng.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("General Report").Range("A2"), Unique:=True
Application.Interactive = True
End Sub

I hope someone can help
Cheers
Mathew
 
I think I'd use a helper column that contains a formula that discounts the
NP's. Then advance filter on that, delete the help column, then cleans up the
advanced filter.

Option Explicit
Sub ECRGeneralReportPopulation()
' Automates The General Report Population

Application.ScreenUpdating = False

Dim myRng As Range
Dim FoundCell As Range
Dim dummyStr As String

dummyStr = "zzzzzzzzzzzzz"

Worksheets("General Report").Range("A:A").ClearContents

With Worksheets("Invoice record")
.Columns(1).Insert
With .Range("A1:a" & .Cells(.Rows.Count, "B").End(xlUp).Row)
.Formula = "=if(d1=""np"",""" & dummyStr & """,b1)"
.Value = .Value
End With

Set myRng = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))

myRng.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("General Report").Range("A2"), Unique:=True

.Columns(1).Delete
End With

With Worksheets("general report").Range("a:a")
Set FoundCell = Nothing
Set FoundCell = .Cells.Find(what:=dummyStr, LookIn:=xlValues, _
lookAt:=xlWhole, MatchCase:=False, _
after:=.Cells(.Cells.Count), _
searchdirection:=xlPrevious)
If FoundCell Is Nothing Then
'do nothing
Else
FoundCell.EntireRow.Delete
End If

End With

Application.ScreenUpdating = True

End Sub

Be careful. I still don't know where your headers are and where your data
really starts. (And I changed application.interactive to
application.screenupdating.

The screenupdating = false hides the flickering of the screen.
 
Back
Top