keilah
08-15-2007, 02:18 AM
hi i have the following vba code.
I need the code to stop inserting row in the ActualData worksheet and just delete the item i have told it to delete from the Eligible Portfolios sheet.
I also need to keep row 8 columns c to ay fixed "header information" - all other rows below if deleted - with the macro function to move up one, keeping the data compact.
Also need to auto function filter removed......
here is the code:
Public Sub DeletionCriteria()
Dim mpCriteria As String
Do
mpCriteria = InputBox("PLEASE DELETE ANY OLD PORTFOLIO DATA - ")
If mpCriteria <> "" Then
Call DeleteData(Worksheets("EligiblePortfolios").Columns("B:B"), mpCriteria, True)
Call DeleteData(Worksheets("ActualData").Columns("E:E"), mpCriteria)
End If
Loop While mpCriteria <> ""
End Sub
Private Sub DeleteData(pzData As Range, pzCriteria, Optional blnHeader As Boolean = False)
If pzData.Parent.AutoFilterMode Then
pzData.AutoFilter
End If
With Intersect(pzData, pzData.Parent.UsedRange)
If Not blnHeader Then
.Parent.Rows(1).Insert
.Cells(1, 1).Value = ""
.AutoFilter Field:=1, Criteria1:=pzCriteria
If Not Intersect(.Parent.Range("14:65536"), .SpecialCells(xlCellTypeVisible)) Is Nothing Then
Intersect(.Parent.Range("14:65536"), .SpecialCells(xlCellTypeVisible)).EntireRow.Delete
End If
.AutoFilter
Else
.AutoFilter Field:=1, Criteria1:=pzCriteria
.Offset(14, 0).Resize(.Rows.Count - 14).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.AutoFilter
End If
End With
End Sub
thanks.
I need the code to stop inserting row in the ActualData worksheet and just delete the item i have told it to delete from the Eligible Portfolios sheet.
I also need to keep row 8 columns c to ay fixed "header information" - all other rows below if deleted - with the macro function to move up one, keeping the data compact.
Also need to auto function filter removed......
here is the code:
Public Sub DeletionCriteria()
Dim mpCriteria As String
Do
mpCriteria = InputBox("PLEASE DELETE ANY OLD PORTFOLIO DATA - ")
If mpCriteria <> "" Then
Call DeleteData(Worksheets("EligiblePortfolios").Columns("B:B"), mpCriteria, True)
Call DeleteData(Worksheets("ActualData").Columns("E:E"), mpCriteria)
End If
Loop While mpCriteria <> ""
End Sub
Private Sub DeleteData(pzData As Range, pzCriteria, Optional blnHeader As Boolean = False)
If pzData.Parent.AutoFilterMode Then
pzData.AutoFilter
End If
With Intersect(pzData, pzData.Parent.UsedRange)
If Not blnHeader Then
.Parent.Rows(1).Insert
.Cells(1, 1).Value = ""
.AutoFilter Field:=1, Criteria1:=pzCriteria
If Not Intersect(.Parent.Range("14:65536"), .SpecialCells(xlCellTypeVisible)) Is Nothing Then
Intersect(.Parent.Range("14:65536"), .SpecialCells(xlCellTypeVisible)).EntireRow.Delete
End If
.AutoFilter
Else
.AutoFilter Field:=1, Criteria1:=pzCriteria
.Offset(14, 0).Resize(.Rows.Count - 14).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.AutoFilter
End If
End With
End Sub
thanks.