PDA

View Full Version : Delete rows in spreadsheet that are not needed



dwinn86
10-04-2011, 01:01 AM
Hi everyone,

I am not sure if I am in the correct forum so here goes.

I am trying to write a program in VBA that grabs a spreadsheet from my computers desktop, opens the spreadsheet, looks at a particular column and loops through the spreadsheet (just looking at this one column throughout the spreadsheet) looking for the following words ('Data Due', 'Files Due', Indent Due', 'Quantities Due').

The program loops through this one column and if the cell doesnt contain any of these words, the entire row gets deleted.

It then loops through this column until the end of the file is reached.

Here is my code so far:

Sub ExamsListFormat()
Dim LineData As String
Dim dansArray As Variant
Dim dansRange As Range
Dim I As Long

'Set cncurrent = CurrentProject.Connection
'Set recSet = New ADODB.Recordset
' Open the spreadsheet
'Open "C:\Test\test.xls" For Input As #1
dansArray = Array("Indent", "Files Due", "Quantities Due")
'Do While Not EOF(1)

' Read a line of data.
'Line Input #1, LineData

For I = LBound(dansArray) To UBound(dansArray)

'Sheet with the data
With ActiveSheet
'Firstly, remove the AutoFilter
.AutoFilterMode = False
'Apply the filter
.Range("O3:O" & .Rows.Count).AutoFilter Field:=1, Criteria1:=dansArray(I)
Set dansRange = Nothing
With .AutoFilter.Range
On Error Resume Next
Set dansRange = .Offset(1, 0).Resize(.Rows.Count - 1, 1) '.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not dansRange Is Nothing Then dansRange.EntireRow.Delete
End With
'Remove the AutoFilter
.AutoFilterMode = False
End With
Next I

With Application
.ScreenUpdating = True
.Calculation = calcmode
End With

'Loop

' Close the data file.
'Close #1
MsgBox "Exams Office Meeting List Scanned Successfully..."

End Sub


When I execute this code...the entire spreadsheet gets deleted.

Could anybody shine a light on why this is happening please?

All advice will be much appreciated.

Many Thanks,

Dan

Bob Phillips
10-04-2011, 03:23 AM
Sub ExamsListFormat()
Const LOOKUP_VALUES As String = "{""Data Due"",""Files Due"",""Indent Due"",""Quantities Due""}"
Dim wb As Workbook
Dim rng As Range
Dim Lastrow As Long
Dim calcmode As XlCalculation
Dim I As Long

With Application
.ScreenUpdating = False
calcmode = .Calculation
.Calculation = xlCalculationManual
End With

Set wb = Workbooks.Open(Filename:=CreateObject("WScript.Shell").SpecialFolders("DeskTop") & Application.PathSeparator & "Test.xls")
With wb.Worksheets(1)

Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
.AutoFilterMode = False
.Columns(2).Insert
.Range("B1").Value = "tmp"
.Range("B2").Resize(Lastrow - 1).Formula = "=NOT(ISNUMBER(MATCH(A2," & LOOKUP_VALUES & ",0)))"
Set rng = .Range("B1").Resize(Lastrow - 1)
rng.AutoFilter field:=1, Criteria1:="=TRUE"

On Error Resume Next
Set rng = rng.Offset(1, 0).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then

rng.EntireRow.Delete
End If

.Columns(2).Delete
End With

With Application
.ScreenUpdating = True
.Calculation = calcmode
End With

MsgBox "Exams Office Meeting List Scanned Successfully..."

End Sub