PDA

View Full Version : Solved: Loop through multiple sheets and delete rows based on a cell reference



d4y88
09-28-2012, 01:59 AM
Hi,

I have a spreadsheet with multiple sheets, some of which have "AOB" at the end of their name. I was previously given this code to loop through these sheets and paste a template sheet over the top:

Dim oSh As Worksheet
Dim oTemplate As Worksheet
Set oTemplate = Worksheets("Template")
For Each oSh In Worksheets
If Right(oSh.Name, 3) = "AOB" Then
oTemplate.UsedRange.Copy oSh.Range("A1")


End If
Next

Within my template sheet there are various look ups and formulas that return information specific to the sheet it has been pasted too. I am now trying to delete the rows on these sheets "AOB" that contain the word "empty" in column A, this is to tidy up the sheets after the formulas have linked through (the word "empty" is just returned by an if statement if there is no data). I need it to loop through all the sheets in the workbook that end in "AOB", is anybody able to help?

Thanks.

CodeNinja
09-28-2012, 07:26 AM
something like this might work...
Sub loopAndDelete()
Dim oSh As Worksheet
Dim oTemplate As Worksheet
Dim l As Long

Set oTemplate = Worksheets("Template")
For Each oSh In Worksheets
If Right(oSh.Name, 3) = "AOB" Then
For l = oSh.UsedRange.Rows.Count To 1 Step -1
If Trim(LCase(oSh.Cells(l, "A"))) = "empty" Then
oSh.Range("A" & l).EntireRow.Delete
End If
Next l


End If
Next

End Sub

Trebor76
09-29-2012, 10:01 PM
Hi dy488,

Try this (initially on a copy of your data as the results cannot be undone if they're not as expected) which should be quite quick as it doesn't use looping:


Option Explicit
Sub Macro2()
'-------------------------------------------------------------------------------------------------'
'Macro to delete any row(s) that have the text 'empty' in Col. A. only for sheets that end in 'AOB'
'Written by Trebor76 '
'Vist my website: www.excelguru.net.au (http://www.excelguru.net.au) '
'-------------------------------------------------------------------------------------------------'

Dim lngEndRow As Long, _
lngMyCol As Long
Dim wstTab As Worksheet
Dim xlnCalcMethod As XlCalculation

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

For Each wstTab In ThisWorkbook.Sheets
With wstTab
If Right(.Name, 3) = "AOB" Then
If WorksheetFunction.CountA(.Cells) > 0 Then
lngEndRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lngMyCol = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
With Range(Sheets(wstTab.Name).Cells(1, lngMyCol), Sheets(wstTab.Name).Cells(lngEndRow, lngMyCol))
.Formula = "=IF(A1=""empty"",""DEL"","""")"
.Calculate
.Value = .Value
End With
With .Columns(lngMyCol)
.Replace "DEL", "#N/A", xlWhole
On Error Resume Next 'Turn error reporting off - OK to ignore 'No cells found' message
.SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
On Error GoTo 0 'Turn error reporting back on
.Delete
End With
End If
End If
End With
Next wstTab

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

MsgBox "The applicable row(s) have now been deleted.", vbInformation, "Excel Guru © Delete Row Editor"

End Sub

Regards,

Robert

snb
09-30-2012, 02:52 AM
or simply:

Sub tst()
For Each sh In Sheets
If InStr(sh.Name, "AOB") > 0 Then Columns(1).SpecialCells(-4123, 4).clearcontents
Next
End Sub

d4y88
10-01-2012, 01:35 AM
Thanks for all the suggestions, I went for Trebor76's solution in the end. Although Codeninja's appeared to work it seemed to be very slow, possibly due to the volume of data if have in each sheet.

Appreciated as always! Cheers.