PDA

View Full Version : Delete row if value does not exist



f2e4
11-26-2007, 07:14 AM
I am using the below code to look down a column of values and if the value = 0, then delete the entire row.

I now have a list of 466 places on one sheet and a summary sheet with 8-10 places

Would anyone know how to change the code to now look down the summary sheet and then delete all those rows of places on the 1st sheets that are not on the summary sheet

Your help is greatly appreciated



Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False

End With

With ActiveSheet
.Select
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
.DisplayPageBreaks = False
Firstrow = 5
Lastrow = 466
For Lrow = Lastrow To Firstrow Step -1
With .Cells(Lrow, "B")
If Not IsError(.Value) Then
If .Value = 0 Then .EntireRow.Delete

End If
End With
Next Lrow End With

Bob Phillips
11-26-2007, 07:51 AM
Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim iLastRow As Long

With Woksheets("Sheet1")

iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = iLastRow To 1 Step -1

If IsError(Application.Match(.Cells(i, TEST_COLUMN).Value, Worksheets("Summary").Columns(2), 0)) Then

Worksheets("Summary").Rows(i).Delete
End If
Next i
End With

End Sub

Simon Lloyd
11-26-2007, 07:52 AM
Try this:

Sub DeleteDuplicates()
Dim Row As Long
Dim HasDups As Range
Sheets("Sheet1").Select
For Row = Range("A65536").End(xlUp).Row To 2 Step -1
Set HasDups = Sheets("Summary Sheet").Range("A:A").Find(Cells(Row, 1), LookIn:=xlValues, lookat:=xlWhole)
If Not HasDups Is Nothing Then
Else: Cells(Row, 1).EntireRow.Delete
End If
Next Row
End Sub

Simon Lloyd
11-26-2007, 07:56 AM
heyyyyyyyyy! mind me toes Bob! Lol, both you and i forgot to turn ScreenUpdating off and then back on!

Note to Op: at top of code place Application.Screenupdating = False and before end sub Application.ScreenUpdating = Trueit prevents screen flicker when the macro is running.

Steel toecaps next time Bob!

Simon Lloyd
11-26-2007, 07:57 AM
I have to admit Bob yours is more elegant and user friendly as the Op can change the column without too much trouble ;)

f2e4
11-26-2007, 08:22 AM
Sorry I'm a bit lost as I still very new to coding

This is my full code in all its glory:


Sub Summary_Table()
'
' Summary_Table Macro
'
'
'THIS STORES THE ORIGINAL ACTIVE SHEETS NAME FOR REFERENCING AND USE IN THE SUMPRODUCT FUNCTION
Dim wksSummary As String
wksSummary = ActiveSheet.Name

'THIS SECTION WILL PASTE TABLE TEMPLATE INTO NEW SUMMARY WORKSHEET
Dim wksNew As Worksheet
Sheets("Template").Visible = True
Set wksNew = Sheets.Add(After:=Sheets(Sheets.Count))
Sheets("Template").Cells.Copy wksNew.Range("A1")
Sheets("Template").Select
ActiveWindow.SelectedSheets.Visible = False

' THIS SELECTS THE 1ST CELL AND INPUTS THE SUMPRODUCT FUNCTION FOR THE TEMPLATE

Range("C5").Select
ActiveCell.FormulaR1C1 = _
Replace("=(SUMPRODUCT(XXX!R46C12:R75C12, (XXX!R46C6:R75C6= RC2) + 0, (XXX!R46C11:R75C11= R3C) +0)*0.57) + (SUMPRODUCT(XXX!R46C12:R75C12, (XXX!R46C6:R75C6= RC2) + 0, (XXX!R46C11:R75C11= R3C) +0)*0.38) + (SUMPRODUCT(XXX!R46C12:R75C12, (XXX!R46C6:R75C6= RC2) + 0, (XXX!R46C11:R75C11= R3C) +0)*0.08)", "XXX", wksSummary)
Range("C5").Select
Selection.AutoFill Destination:=Range("C5:W5"), Type:=xlFillDefault
Range("C5:W5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.FillDown
Range("A1").Select


' THIS SECTION WILL ASK TO RENAME THE SUMMARY WORKSHEET
ActNm = ActiveSheet.Name
On Error Resume Next
ActiveSheet.Name = wksSummary
NoName: If Err.Number = 1004 Then ActiveSheet.Name = Replace("BBB - Summary", "BBB", wksSummary)
If ActiveSheet.Name = ActNm Then GoTo NoName
On Error GoTo 0

'THIS SECTION OF THE MACRO WILL LOOK THROUGH THE LIST OF SITE TYPES AND REMOVES ALL ROWS WITH A TOTAL COST OF 0
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
With ActiveSheet
.Select
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
.DisplayPageBreaks = False
Firstrow = 5
Lastrow = 466
For Lrow = Lastrow To Firstrow Step -1
With .Cells(Lrow, "X")
If Not IsError(.Value) Then
If .Value = 0 Then .EntireRow.Delete
End If
End With
Next Lrow
End With

'REMOVES FUNCTIONS AND PASTES ONLY VALUES
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Range("C1:W1").Select
ActiveCell.FormulaR1C1 = Replace("AAA", "AAA", wksSummary)
Range("C2:W2").Select
'THIS SECTION WILL DISPLAY THE CONFIRMATION BOX
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
If MsgBox(prompt:="Your summary is now complete", Buttons:=vbOK, Title:="Summary Completed") = vbOK Then Exit Sub

End Sub


The section I was looking help with was where I am deleting all the rows that equal 0

The sheet (wksNew) has the full list of 466 places
The sheet (wksSummary) has only 8-9 places in column F46:F75

I wanted all the sites in wksNew that are not in wksSummary to be deleted

My SUMPRODUCT was originally set up to calculate 466 rows and 22 columns of cells but is there a way to update this after all those extra rows are deleted.


Sorry for any hassle

Simon Lloyd
11-26-2007, 08:37 AM
Well for me if you are checking column A of WksNew against column F of WksSummary then use:

Sub DeleteDuplicates()
Dim Row As Long
Dim HasDups As Range
Sheets("WksNew").Select
For Row = Range("A65536").End(xlUp).Row To 2 Step -1
Set HasDups = Sheets("WksSummary").Range("F:F").Find(Cells(Row, 1), LookIn:=xlValues, lookat:=xlWhole)
If Not HasDups Is Nothing Then
Else: Cells(Row, 1).EntireRow.Delete
End If
Next Row
End Sub
before your section 'REMOVES FUNCTIONS AND PASTES ONLY VALUES type Call DeleteDuplicates and paste the code above in a standard module, not the module you already have your code in as there may be a conflict with DIM'med names.