Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
MACRO HELP - deleting rows containing a range of blank cells
Just wanted to move this up the forums as my subsequent question (below)
would be lost otherwise... --------------------- As an extra, if I wanted to specify a range of cells that, if blank, would result in the deletion of the rows where those cells lie, how would I do this? Thanks again. David "Gord Dibben" wrote: David Try this macro to delete just empty rows. Sub DeleteEmptyRows() ''only if entire row is blank LastRow = ActiveSheet.UsedRange.Row - 1 + _ ActiveSheet.UsedRange.Rows.Count Application.ScreenUpdating = False For r = LastRow To 1 Step -1 If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete End If Next r End Sub Gord Dibben MS Excel MVP On Fri, 23 Feb 2007 05:33:29 -0800, DavidHawes wrote: Hi, I've set up a macro which re-organises an excel spreadsheet into a format that enables me to import the data contained within it directly into an Access database i've set up. This works perfectly. However, I want the macro to delete out any lines of my table (which is fixed in size) that do not contain any data. Is this possible? If so, can someone please explain what code I need to enter to get my macro to do this? Many thanks, David :-) |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
MACRO HELP - deleting rows containing a range of blank cells
Option Explicit
Sub DeleteEmptyRowsInSelectionIfWholeRowIsEmpty() Dim FirstRow As Long Dim LastRow As Long Dim r As Long Dim myRng As Range Set myRng = Selection.Areas(1).EntireRow.Columns(1) With myRng FirstRow = .Row LastRow = .Rows(.Rows.Count).Row End With Application.ScreenUpdating = False For r = LastRow To FirstRow Step -1 If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete End If Next r End Sub Based on one cell: Option Explicit Sub DeleteEmptyRowsInSelectionIfCellIsEmpty() On Error Resume Next Selection.Areas(1).Columns(1).Cells.SpecialCells(x lCellTypeBlanks) _ .EntireRow.Delete On Error GoTo 0 End Sub DavidHawes wrote: Just wanted to move this up the forums as my subsequent question (below) would be lost otherwise... --------------------- As an extra, if I wanted to specify a range of cells that, if blank, would result in the deletion of the rows where those cells lie, how would I do this? Thanks again. David "Gord Dibben" wrote: David Try this macro to delete just empty rows. Sub DeleteEmptyRows() ''only if entire row is blank LastRow = ActiveSheet.UsedRange.Row - 1 + _ ActiveSheet.UsedRange.Rows.Count Application.ScreenUpdating = False For r = LastRow To 1 Step -1 If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete End If Next r End Sub Gord Dibben MS Excel MVP On Fri, 23 Feb 2007 05:33:29 -0800, DavidHawes wrote: Hi, I've set up a macro which re-organises an excel spreadsheet into a format that enables me to import the data contained within it directly into an Access database i've set up. This works perfectly. However, I want the macro to delete out any lines of my table (which is fixed in size) that do not contain any data. Is this possible? If so, can someone please explain what code I need to enter to get my macro to do this? Many thanks, David :-) -- Dave Peterson |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
MACRO HELP - deleting rows containing a range of blank cells
You can adapt the DeleteBlankRows code on
http://www.cpearson.com/excel/deleting.htm to your needs. Specifically, '--------------------------- Change '--------------------------- Sub DeleteBlankRows(Optional WorksheetName As Variant) ' To Sub DeleteBlankRows(ScanRange As Range, Optional WorksheetName As Variant) '--------------------------- Delete '--------------------------- Set Rng = WS.Cells.Find(what:="*", after:=WS.Cells(WS.Rows.Count, WS.Columns.Count), lookat:=xlPart, _ searchorder:=xlByColumns, searchdirection:=xlPrevious, MatchCase:=False) '------------------------ Add: '------------------------ Dim FirstRow As Long '------------------------ Change '------------------------ LastRow = Rng.Row ' To LastRow = ScanRange.Cells(ScanRange.Cells.Count).Row FirstRow = ScanRange(1, 1).Row '------------------------ Change '------------------------ For RowNum = LastRow To 1 Step -1 ' To For RowNum = LastRow To FirstRow Step -1 You can then call this code with a procedure call like Sub DoDelete() DeleteBlankRows ScanRange:=Range("A1:A100") End Sub -- Cordially, Chip Pearson Microsoft MVP - Excel Pearson Software Consulting, LLC www.cpearson.com (email address is on the web site) "DavidHawes" wrote in message ... Just wanted to move this up the forums as my subsequent question (below) would be lost otherwise... --------------------- As an extra, if I wanted to specify a range of cells that, if blank, would result in the deletion of the rows where those cells lie, how would I do this? Thanks again. David "Gord Dibben" wrote: David Try this macro to delete just empty rows. Sub DeleteEmptyRows() ''only if entire row is blank LastRow = ActiveSheet.UsedRange.Row - 1 + _ ActiveSheet.UsedRange.Rows.Count Application.ScreenUpdating = False For r = LastRow To 1 Step -1 If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete End If Next r End Sub Gord Dibben MS Excel MVP On Fri, 23 Feb 2007 05:33:29 -0800, DavidHawes wrote: Hi, I've set up a macro which re-organises an excel spreadsheet into a format that enables me to import the data contained within it directly into an Access database i've set up. This works perfectly. However, I want the macro to delete out any lines of my table (which is fixed in size) that do not contain any data. Is this possible? If so, can someone please explain what code I need to enter to get my macro to do this? Many thanks, David :-) |
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
MACRO HELP - deleting rows containing a range of blank cells
Hi,
Thanks for this, although it's not quite what i'm after and I can't quite seem to make the code work using the second example you quote... What I require is for a whole row to be deleted if the cells in specified rows within my table (in my case A4:M4, A5:M5, A6:M6 etc) are blank. I tried the following using your example: On Error Resume Next Range("A10:M11").Cells.SpecialCells(xlCellTypeBlan ks) _ .EntireRow.Delete On Error GoTo 0 but this didn't work. Any help would be gratefully appreciated. Many thanks, David Hawes "Dave Peterson" wrote: Option Explicit Sub DeleteEmptyRowsInSelectionIfWholeRowIsEmpty() Dim FirstRow As Long Dim LastRow As Long Dim r As Long Dim myRng As Range Set myRng = Selection.Areas(1).EntireRow.Columns(1) With myRng FirstRow = .Row LastRow = .Rows(.Rows.Count).Row End With Application.ScreenUpdating = False For r = LastRow To FirstRow Step -1 If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete End If Next r End Sub Based on one cell: Option Explicit Sub DeleteEmptyRowsInSelectionIfCellIsEmpty() On Error Resume Next Selection.Areas(1).Columns(1).Cells.SpecialCells(x lCellTypeBlanks) _ .EntireRow.Delete On Error GoTo 0 End Sub DavidHawes wrote: Just wanted to move this up the forums as my subsequent question (below) would be lost otherwise... --------------------- As an extra, if I wanted to specify a range of cells that, if blank, would result in the deletion of the rows where those cells lie, how would I do this? Thanks again. David "Gord Dibben" wrote: David Try this macro to delete just empty rows. Sub DeleteEmptyRows() ''only if entire row is blank LastRow = ActiveSheet.UsedRange.Row - 1 + _ ActiveSheet.UsedRange.Rows.Count Application.ScreenUpdating = False For r = LastRow To 1 Step -1 If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete End If Next r End Sub Gord Dibben MS Excel MVP On Fri, 23 Feb 2007 05:33:29 -0800, DavidHawes wrote: Hi, I've set up a macro which re-organises an excel spreadsheet into a format that enables me to import the data contained within it directly into an Access database i've set up. This works perfectly. However, I want the macro to delete out any lines of my table (which is fixed in size) that do not contain any data. Is this possible? If so, can someone please explain what code I need to enter to get my macro to do this? Many thanks, David :-) -- Dave Peterson |
#5
Posted to microsoft.public.excel.misc
|
|||
|
|||
MACRO HELP - deleting rows containing a range of blank cells
Should i enter the code from http://www.cpearson.com/excel/deleting.htm in
the same macro as the.... DeleteBlankRows ScanRange:=Range("A1:A100") .... function or should this be the code from http://www.cpearson.com/excel/deleting.htm be set up elsewhere? (eg. as a module?) Thanks, David "Chip Pearson" wrote: You can adapt the DeleteBlankRows code on http://www.cpearson.com/excel/deleting.htm to your needs. Specifically, '--------------------------- Change '--------------------------- Sub DeleteBlankRows(Optional WorksheetName As Variant) ' To Sub DeleteBlankRows(ScanRange As Range, Optional WorksheetName As Variant) '--------------------------- Delete '--------------------------- Set Rng = WS.Cells.Find(what:="*", after:=WS.Cells(WS.Rows.Count, WS.Columns.Count), lookat:=xlPart, _ searchorder:=xlByColumns, searchdirection:=xlPrevious, MatchCase:=False) '------------------------ Add: '------------------------ Dim FirstRow As Long '------------------------ Change '------------------------ LastRow = Rng.Row ' To LastRow = ScanRange.Cells(ScanRange.Cells.Count).Row FirstRow = ScanRange(1, 1).Row '------------------------ Change '------------------------ For RowNum = LastRow To 1 Step -1 ' To For RowNum = LastRow To FirstRow Step -1 You can then call this code with a procedure call like Sub DoDelete() DeleteBlankRows ScanRange:=Range("A1:A100") End Sub -- Cordially, Chip Pearson Microsoft MVP - Excel Pearson Software Consulting, LLC www.cpearson.com (email address is on the web site) "DavidHawes" wrote in message ... Just wanted to move this up the forums as my subsequent question (below) would be lost otherwise... --------------------- As an extra, if I wanted to specify a range of cells that, if blank, would result in the deletion of the rows where those cells lie, how would I do this? Thanks again. David "Gord Dibben" wrote: David Try this macro to delete just empty rows. Sub DeleteEmptyRows() ''only if entire row is blank LastRow = ActiveSheet.UsedRange.Row - 1 + _ ActiveSheet.UsedRange.Rows.Count Application.ScreenUpdating = False For r = LastRow To 1 Step -1 If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete End If Next r End Sub Gord Dibben MS Excel MVP On Fri, 23 Feb 2007 05:33:29 -0800, DavidHawes wrote: Hi, I've set up a macro which re-organises an excel spreadsheet into a format that enables me to import the data contained within it directly into an Access database i've set up. This works perfectly. However, I want the macro to delete out any lines of my table (which is fixed in size) that do not contain any data. Is this possible? If so, can someone please explain what code I need to enter to get my macro to do this? Many thanks, David :-) |
#6
Posted to microsoft.public.excel.misc
|
|||
|
|||
MACRO HELP - deleting rows containing a range of blank cells
this is how my entire macro currently looks... it is not currently deleting
the data out of the cells where the ranges specified are blank... i can't quite suss out where i'm going wrong... Sub FamilyPlanningDatabasePrep() ' ' FamilyPlanningDatabasePrep Macro ' Prepares FP return for import into sexual health database - this macro creates a file labled IMPORT on your desktop ' ' MsgBox ("This macro formats the FP activity sheet so it can be imported into the Family Planning & Sexual Health Database" & vbNewLine & vbNewLine & "The file created is titled 'IMPORT' and can be found in your c:\ drive" & vbNewLine & vbNewLine & "Once complete, open Family Planning & Sexual Health Database and follow instructions to import data") Range("C1:E1,H1:I1,H34:I34,C34:E34").Select Range("C34").Activate With Selection .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Range("C4:C33,G4:G33,M34,M1").Select Range("M1").Activate ActiveWindow.SmallScroll Down:=33 Range("C4:C33,G4:G33,M34,M1,C37:C66,G37:G66").Sele ct Range("G37").Activate Selection.Replace what:=".", Replacement:="/", lookat:=xlPart, _ searchorder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False ActiveWindow.SmallScroll Down:=-42 Range("A3").Select ActiveCell.FormulaR1C1 = "attendanceTIME" With ActiveCell.Characters(Start:=1, Length:=14).Font .Name = "Arial" .FontStyle = "Bold" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("B3").Select ActiveCell.FormulaR1C1 = "patientID" With ActiveCell.Characters(Start:=1, Length:=9).Font .Name = "Arial" .FontStyle = "Bold" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("C3").Select ActiveCell.FormulaR1C1 = "patientDOB" With ActiveCell.Characters(Start:=1, Length:=10).Font .Name = "Arial" .FontStyle = "Bold" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("D3").Select ActiveCell.FormulaR1C1 = "patientSEX" With ActiveCell.Characters(Start:=1, Length:=10).Font .Name = "Arial" .FontStyle = "Bold" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("E3").Select ActiveCell.FormulaR1C1 = "patientCOUNTY" With ActiveCell.Characters(Start:=1, Length:=13).Font .Name = "Arial" .FontStyle = "Bold" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("F3").Select ActiveCell.FormulaR1C1 = "patientSOURCE" With ActiveCell.Characters(Start:=1, Length:=13).Font .Name = "Arial" .FontStyle = "Bold" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("G3").Select ActiveCell.FormulaR1C1 = "DATEreferral/prevatt" With ActiveCell.Characters(Start:=1, Length:=20).Font .Name = "Arial" .FontStyle = "Bold" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("H3").Select ActiveCell.FormulaR1C1 = "referralSOURCE" With ActiveCell.Characters(Start:=1, Length:=14).Font .Name = "Arial" .FontStyle = "Bold" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("I3").Select ActiveCell.FormulaR1C1 = "attendanceOUTCOME" With ActiveCell.Characters(Start:=1, Length:=17).Font .Name = "Arial" .FontStyle = "Bold" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("J3").Select ActiveCell.FormulaR1C1 = "attendanceREASON 1" With ActiveCell.Characters(Start:=1, Length:=18).Font .Name = "Arial" .FontStyle = "Bold" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("K3").Select ActiveCell.FormulaR1C1 = "attendanceREASON 2" With ActiveCell.Characters(Start:=1, Length:=18).Font .Name = "Arial" .FontStyle = "Bold" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("L3").Select ActiveCell.FormulaR1C1 = "attendanceMETHOD 1" With ActiveCell.Characters(Start:=1, Length:=18).Font .Name = "Arial" .FontStyle = "Bold" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("M3").Select ActiveCell.FormulaR1C1 = "attendanceMETHOD 2" With ActiveCell.Characters(Start:=1, Length:=18).Font .Name = "Arial" .FontStyle = "Bold" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("N3").Select ActiveCell.FormulaR1C1 = "attendanceLOCATION" Range("O3").Select ActiveCell.FormulaR1C1 = "attendanceDATE" Range("P3").Select ActiveCell.FormulaR1C1 = "clinicTYPE" Range("H1").Select Selection.Copy Range("N4:N33").Select ActiveSheet.Paste Range("M1").Select Application.CutCopyMode = False Selection.Copy Range("O4:O33").Select ActiveSheet.Paste Range("C1").Select Application.CutCopyMode = False Selection.Copy Range("P4:P33").Select ActiveSheet.Paste ActiveWindow.SmallScroll Down:=33 Range("H34").Select Application.CutCopyMode = False Selection.Copy Range("N37:N66").Select ActiveSheet.Paste Range("M34").Select Application.CutCopyMode = False Selection.Copy Range("O37:O66").Select ActiveSheet.Paste Range("C34").Select Application.CutCopyMode = False Selection.Copy Range("P37:P66").Select ActiveSheet.Paste ActiveWindow.SmallScroll Down:=-21 Rows("34:36").Select Range("A36").Activate ActiveWindow.SmallScroll Down:=-27 Range("34:36,1:2").Select Range("A2").Activate Application.CutCopyMode = False Selection.Delete shift:=xlUp Range("I14").Select Application.DisplayAlerts = False Sheets("Lookup tables").Select ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = True DeleteBlankRows ScanRange:=Range("A4:M4") DeleteBlankRows ScanRange:=Range("A5:M5") DeleteBlankRows ScanRange:=Range("A6:M6") DeleteBlankRows ScanRange:=Range("A7:M7") DeleteBlankRows ScanRange:=Range("A8:M8") DeleteBlankRows ScanRange:=Range("A9:M9") DeleteBlankRows ScanRange:=Range("A10:M10") DeleteBlankRows ScanRange:=Range("A11:M11") DeleteBlankRows ScanRange:=Range("A12:M12") DeleteBlankRows ScanRange:=Range("A13:M13") DeleteBlankRows ScanRange:=Range("A14:M14") DeleteBlankRows ScanRange:=Range("A15:M15") DeleteBlankRows ScanRange:=Range("A16:M16") DeleteBlankRows ScanRange:=Range("A17:M17") DeleteBlankRows ScanRange:=Range("A18:M18") DeleteBlankRows ScanRange:=Range("A19:M19") DeleteBlankRows ScanRange:=Range("A20:M20") DeleteBlankRows ScanRange:=Range("A21:M21") DeleteBlankRows ScanRange:=Range("A22:M22") DeleteBlankRows ScanRange:=Range("A23:M23") DeleteBlankRows ScanRange:=Range("A24:M24") DeleteBlankRows ScanRange:=Range("A25:M25") DeleteBlankRows ScanRange:=Range("A26:M26") DeleteBlankRows ScanRange:=Range("A27:M27") DeleteBlankRows ScanRange:=Range("A28:M28") DeleteBlankRows ScanRange:=Range("A29:M29") DeleteBlankRows ScanRange:=Range("A30:M30") DeleteBlankRows ScanRange:=Range("A31:M31") DeleteBlankRows ScanRange:=Range("A32:M32") DeleteBlankRows ScanRange:=Range("A33:M33") DeleteBlankRows ScanRange:=Range("A34:M34") DeleteBlankRows ScanRange:=Range("A35:M35") DeleteBlankRows ScanRange:=Range("A36:M36") DeleteBlankRows ScanRange:=Range("A37:M37") DeleteBlankRows ScanRange:=Range("A38:M38") DeleteBlankRows ScanRange:=Range("A39:M39") DeleteBlankRows ScanRange:=Range("A40:M40") DeleteBlankRows ScanRange:=Range("A41:M41") DeleteBlankRows ScanRange:=Range("A42:M42") DeleteBlankRows ScanRange:=Range("A43:M43") DeleteBlankRows ScanRange:=Range("A44:M44") DeleteBlankRows ScanRange:=Range("A45:M45") DeleteBlankRows ScanRange:=Range("A46:M46") DeleteBlankRows ScanRange:=Range("A47:M47") DeleteBlankRows ScanRange:=Range("A48:M48") DeleteBlankRows ScanRange:=Range("A49:M49") DeleteBlankRows ScanRange:=Range("A50:M50") DeleteBlankRows ScanRange:=Range("A51:M51") DeleteBlankRows ScanRange:=Range("A52:M52") DeleteBlankRows ScanRange:=Range("A53:M53") DeleteBlankRows ScanRange:=Range("A54:M54") DeleteBlankRows ScanRange:=Range("A55:M55") DeleteBlankRows ScanRange:=Range("A56:M56") DeleteBlankRows ScanRange:=Range("A57:M57") DeleteBlankRows ScanRange:=Range("A58:M58") DeleteBlankRows ScanRange:=Range("A59:M59") DeleteBlankRows ScanRange:=Range("A60:M60") DeleteBlankRows ScanRange:=Range("A61:M61") DeleteBlankRows ScanRange:=Range("A62:M62") DeleteBlankRows ScanRange:=Range("A63:M63") DeleteBlankRows ScanRange:=Range("A64:M64") DeleteBlankRows ScanRange:=Range("A65:M65") DeleteBlankRows ScanRange:=Range("A66:M66") ChDir "C:\" ActiveWorkbook.SaveAs Filename:= _ "C:\IMPORT.xls", FileFormat:=xlNormal, _ Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _ CreateBackup:=False MsgBox ("Remember to delete all empty lines from table" & vbNewLine & vbNewLine & "Once complete, select 'SAVE'" & vbNewLine & vbNewLine & "A file will be generated in your c:\ drive titled 'IMPORT'" & vbNewLine & vbNewLine & "Import into Family Planning Database") End Sub Sub DeleteBlankRows(ScanRange As Range, Optional WorksheetName As Variant) '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''' ' DeleteBlankRows ' This function will delete all blank rows on the worksheet ' named by WorksheetName. This will delete rows that are ' completely blank (every cell = vbNullString) or that have ' cells that contain only an apostrophe (special Text control ' character). ' The code will look at each cell that contains a formula, ' then look at the precedents of that formula, and will not ' delete rows that are a precedent to a formula. This will ' prevent deleting precedents of a formula where those ' precedents are in lower numbered rows than the formula ' (e.g., formula in A10 references A1:A5). If a formula ' references cell that are below (higher row number) the ' last used row (e.g, formula in A10 reference A20:A30 and ' last used row is A15), the refences in the formula will ' be changed due to the deletion of rows above the formula. ' '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''' Dim RefColl As Collection Dim RowNum As Long Dim Prec As Range Dim Rng As Range Dim DeleteRange As Range Dim LastRow As Long Dim FormulaCells As Range Dim Test As Long Dim WS As Worksheet Dim PrecCell As Range If IsMissing(WorksheetName) = True Then Set WS = ActiveSheet Else On Error Resume Next Set WS = ActiveWorkbook.Worksheets(WorksheetName) If Err.Number < 0 Then ''''''''''''''''''''''''''''''' ' Invalid worksheet name. ''''''''''''''''''''''''''''''' Exit Sub End If End If If Application.WorksheetFunction.CountA(WS.UsedRange. Cells) = 0 Then '''''''''''''''''''''''''''''' ' Worksheet is blank. Get Out. '''''''''''''''''''''''''''''' Exit Sub End If '''''''''''''''''''''''''''''''''''''' ' Find the last used cell on the ' worksheet. '''''''''''''''''''''''''''''''''''''' Dim FirstRow As Long LastRow = ScanRange.Cells(ScanRange.Cells.Count).Row FirstRow = ScanRange(1, 1).Row Set RefColl = New Collection ''''''''''''''''''''''''''''''''''''' ' We go from bottom to top to keep ' the references intact, preventing ' #REF errors. ''''''''''''''''''''''''''''''''''''' For RowNum = LastRow To FirstRow Step -1 Set FormulaCells = Nothing If Application.WorksheetFunction.CountA(WS.Rows(RowNu m)) = 0 Then '''''''''''''''''''''''''''''''''''' ' There are no non-blank cells in ' row R. See if R is in the RefColl ' reference Collection. If not, ' add row R to the DeleteRange. '''''''''''''''''''''''''''''''''''' On Error Resume Next Test = RefColl(CStr(RowNum)) If Err.Number < 0 Then '''''''''''''''''''''''''' ' R is not in the RefColl ' collection. Add it to ' the DeleteRange variable. '''''''''''''''''''''''''' If DeleteRange Is Nothing Then Set DeleteRange = WS.Rows(RowNum) Else Set DeleteRange = Application.Union(DeleteRange, WS.Rows(RowNum)) End If Else '''''''''''''''''''''''''' ' R is in the collection. ' Do nothing. '''''''''''''''''''''''''' End If On Error GoTo 0 Err.Clear Else ''''''''''''''''''''''''''''''''''''' ' CountA 0. Find the cells ' containing formula, and for ' each cell with a formula, find ' its precedents. Add the row number ' of each precedent to the RefColl ' collection. ''''''''''''''''''''''''''''''''''''' If IsRowClear(RowNum:=RowNum) = True Then ''''''''''''''''''''''''''''''''' ' Row contains nothing but blank ' cells or cells with only an ' apostrophe. Cells that contain ' only an apostrophe are counted ' by CountA, so we use IsRowClear ' to test for only apostrophes. ' Test if this row is in the ' RefColl collection. If it is ' not in the collection, add it ' to the DeleteRange. ''''''''''''''''''''''''''''''''' On Error Resume Next Test = RefColl(CStr(RowNum)) If Err.Number = 0 Then '''''''''''''''''''''''''''''''''''''' ' Row exists in RefColl. That means ' a formula is referencing this row. ' Do not delete the row. '''''''''''''''''''''''''''''''''''''' Else If DeleteRange Is Nothing Then Set DeleteRange = WS.Rows(RowNum) Else Set DeleteRange = Application.Union(DeleteRange, WS.Rows(RowNum)) End If End If Else On Error Resume Next Set FormulaCells = Nothing Set FormulaCells = WS.Rows(RowNum).SpecialCells(xlCellTypeFormulas) On Error GoTo 0 If FormulaCells Is Nothing Then ''''''''''''''''''''''''' ' No formulas found. Do ' nothing. ''''''''''''''''''''''''' Else '''''''''''''''''''''''''''''''''''''''''''''''''' ' ' Formulas found. Loop through the formula ' cells, and for each cell, find its precedents ' and add the row number of each precedent cell ' to the RefColl collection. '''''''''''''''''''''''''''''''''''''''''''''''''' ' On Error Resume Next For Each Rng In FormulaCells.Cells For Each Prec In Rng.Precedents.Cells RefColl.Add Item:=Prec.Row, key:=CStr(Prec.Row) Next Prec Next Rng On Error GoTo 0 End If End If End If ''''''''''''''''''''''''' ' Go to the next row, ' moving upwards. ''''''''''''''''''''''''' Next RowNum '''''''''''''''''''''''''''''''''''''''''' ' If we have rows to delete, delete them. '''''''''''''''''''''''''''''''''''''''''' If Not DeleteRange Is Nothing Then DeleteRange.EntireRow.Delete shift:=xlShiftUp End If End Sub Function IsRowClear(RowNum As Long) As Boolean '''''''''''''''''''''''''''''''''''''''''''''''''' ' IsRowClear ' This procedure returns True if all the cells ' in the row specified by RowNum as empty or ' contains only a "'" character. It returns False ' if the row contains only data or formulas. '''''''''''''''''''''''''''''''''''''''''''''''''' Dim ColNdx As Long Dim Rng As Range ColNdx = 1 Set Rng = Cells(RowNum, ColNdx) Do Until ColNdx = Columns.Count If (Rng.HasFormula = True) Or (Rng.Value < vbNullString) Then IsRowClear = False Exit Function End If Set Rng = Cells(RowNum, ColNdx).End(xlToRight) ColNdx = Rng.Column Loop IsRowClear = True End Function "DavidHawes" wrote: Should i enter the code from http://www.cpearson.com/excel/deleting.htm in the same macro as the.... DeleteBlankRows ScanRange:=Range("A1:A100") ... function or should this be the code from http://www.cpearson.com/excel/deleting.htm be set up elsewhere? (eg. as a module?) Thanks, David "Chip Pearson" wrote: You can adapt the DeleteBlankRows code on http://www.cpearson.com/excel/deleting.htm to your needs. Specifically, '--------------------------- Change '--------------------------- Sub DeleteBlankRows(Optional WorksheetName As Variant) ' To Sub DeleteBlankRows(ScanRange As Range, Optional WorksheetName As Variant) '--------------------------- Delete '--------------------------- Set Rng = WS.Cells.Find(what:="*", after:=WS.Cells(WS.Rows.Count, WS.Columns.Count), lookat:=xlPart, _ searchorder:=xlByColumns, searchdirection:=xlPrevious, MatchCase:=False) '------------------------ Add: '------------------------ Dim FirstRow As Long '------------------------ Change '------------------------ LastRow = Rng.Row ' To LastRow = ScanRange.Cells(ScanRange.Cells.Count).Row FirstRow = ScanRange(1, 1).Row '------------------------ Change '------------------------ For RowNum = LastRow To 1 Step -1 ' To For RowNum = LastRow To FirstRow Step -1 You can then call this code with a procedure call like Sub DoDelete() DeleteBlankRows ScanRange:=Range("A1:A100") End Sub -- Cordially, Chip Pearson Microsoft MVP - Excel Pearson Software Consulting, LLC www.cpearson.com (email address is on the web site) "DavidHawes" wrote in message ... Just wanted to move this up the forums as my subsequent question (below) would be lost otherwise... --------------------- As an extra, if I wanted to specify a range of cells that, if blank, would result in the deletion of the rows where those cells lie, how would I do this? Thanks again. David "Gord Dibben" wrote: David Try this macro to delete just empty rows. Sub DeleteEmptyRows() ''only if entire row is blank LastRow = ActiveSheet.UsedRange.Row - 1 + _ ActiveSheet.UsedRange.Rows.Count Application.ScreenUpdating = False For r = LastRow To 1 Step -1 If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete End If Next r End Sub Gord Dibben MS Excel MVP On Fri, 23 Feb 2007 05:33:29 -0800, DavidHawes wrote: Hi, I've set up a macro which re-organises an excel spreadsheet into a format that enables me to import the data contained within it directly into an Access database i've set up. This works perfectly. However, I want the macro to delete out any lines of my table (which is fixed in size) that do not contain any data. Is this possible? If so, can someone please explain what code I need to enter to get my macro to do this? Many thanks, David :-) |
#7
Posted to microsoft.public.excel.misc
|
|||
|
|||
MACRO HELP - deleting rows containing a range of blank cells
I'd make the follow changes. First, I would use Intersect with the UsedRange
in case the user selected an entrire colum to scan. Set myRng = Application.Intersect(Selection.Worksheet.UsedRang e, _ Selection.Areas(1).EntireRow.Columns(1)) Also, I would add code for the case in which a cell in the contains only a single apostrophe. Dim ColNdx As Long Dim EmptyRow As Boolean For r = LastRow To FirstRow Step -1 If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete Else ColNdx = 1 EmptyRow = True Do Until ColNdx = Columns.Count If (myRng.Worksheet.Cells(r, ColNdx).HasFormula) Or _ (myRng.Worksheet.Cells(r, ColNdx).Value < vbNullString) Then EmptyRow = False Exit Do End If ColNdx = myRng.Cells(r, ColNdx).End(xlToRight).Column Loop If EmptyRow = True Then Rows(r).Delete End If End If Next r -- Cordially, Chip Pearson Microsoft MVP - Excel Pearson Software Consulting, LLC www.cpearson.com (email address is on the web site) "Dave Peterson" wrote in message ... Option Explicit Sub DeleteEmptyRowsInSelectionIfWholeRowIsEmpty() Dim FirstRow As Long Dim LastRow As Long Dim r As Long Dim myRng As Range Set myRng = Selection.Areas(1).EntireRow.Columns(1) With myRng FirstRow = .Row LastRow = .Rows(.Rows.Count).Row End With Application.ScreenUpdating = False For r = LastRow To FirstRow Step -1 If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete End If Next r End Sub Based on one cell: Option Explicit Sub DeleteEmptyRowsInSelectionIfCellIsEmpty() On Error Resume Next Selection.Areas(1).Columns(1).Cells.SpecialCells(x lCellTypeBlanks) _ .EntireRow.Delete On Error GoTo 0 End Sub DavidHawes wrote: Just wanted to move this up the forums as my subsequent question (below) would be lost otherwise... --------------------- As an extra, if I wanted to specify a range of cells that, if blank, would result in the deletion of the rows where those cells lie, how would I do this? Thanks again. David "Gord Dibben" wrote: David Try this macro to delete just empty rows. Sub DeleteEmptyRows() ''only if entire row is blank LastRow = ActiveSheet.UsedRange.Row - 1 + _ ActiveSheet.UsedRange.Rows.Count Application.ScreenUpdating = False For r = LastRow To 1 Step -1 If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete End If Next r End Sub Gord Dibben MS Excel MVP On Fri, 23 Feb 2007 05:33:29 -0800, DavidHawes wrote: Hi, I've set up a macro which re-organises an excel spreadsheet into a format that enables me to import the data contained within it directly into an Access database i've set up. This works perfectly. However, I want the macro to delete out any lines of my table (which is fixed in size) that do not contain any data. Is this possible? If so, can someone please explain what code I need to enter to get my macro to do this? Many thanks, David :-) -- Dave Peterson |
#8
Posted to microsoft.public.excel.misc
|
|||
|
|||
MACRO HELP - deleting rows containing a range of blank cells
If you copy the entire procedure and make the modifications I described, the
code is in its own procedure. You call that procedure from your own procedure(s). E.g., Sub DeleteBlankRows(ScanRange As Range, Optional WorksheetName As Variant) ' ' My code with revisions. ' End Sub Sub YourCode() ' whatever DeleteBlankRows ScanRange:=Worksheets("Sheet1").Range("A1:A100") ' other code End Sub -- Cordially, Chip Pearson Microsoft MVP - Excel Pearson Software Consulting, LLC www.cpearson.com (email address is on the web site) "DavidHawes" wrote in message ... Should i enter the code from http://www.cpearson.com/excel/deleting.htm in the same macro as the.... DeleteBlankRows ScanRange:=Range("A1:A100") ... function or should this be the code from http://www.cpearson.com/excel/deleting.htm be set up elsewhere? (eg. as a module?) Thanks, David "Chip Pearson" wrote: You can adapt the DeleteBlankRows code on http://www.cpearson.com/excel/deleting.htm to your needs. Specifically, '--------------------------- Change '--------------------------- Sub DeleteBlankRows(Optional WorksheetName As Variant) ' To Sub DeleteBlankRows(ScanRange As Range, Optional WorksheetName As Variant) '--------------------------- Delete '--------------------------- Set Rng = WS.Cells.Find(what:="*", after:=WS.Cells(WS.Rows.Count, WS.Columns.Count), lookat:=xlPart, _ searchorder:=xlByColumns, searchdirection:=xlPrevious, MatchCase:=False) '------------------------ Add: '------------------------ Dim FirstRow As Long '------------------------ Change '------------------------ LastRow = Rng.Row ' To LastRow = ScanRange.Cells(ScanRange.Cells.Count).Row FirstRow = ScanRange(1, 1).Row '------------------------ Change '------------------------ For RowNum = LastRow To 1 Step -1 ' To For RowNum = LastRow To FirstRow Step -1 You can then call this code with a procedure call like Sub DoDelete() DeleteBlankRows ScanRange:=Range("A1:A100") End Sub -- Cordially, Chip Pearson Microsoft MVP - Excel Pearson Software Consulting, LLC www.cpearson.com (email address is on the web site) "DavidHawes" wrote in message ... Just wanted to move this up the forums as my subsequent question (below) would be lost otherwise... --------------------- As an extra, if I wanted to specify a range of cells that, if blank, would result in the deletion of the rows where those cells lie, how would I do this? Thanks again. David "Gord Dibben" wrote: David Try this macro to delete just empty rows. Sub DeleteEmptyRows() ''only if entire row is blank LastRow = ActiveSheet.UsedRange.Row - 1 + _ ActiveSheet.UsedRange.Rows.Count Application.ScreenUpdating = False For r = LastRow To 1 Step -1 If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete End If Next r End Sub Gord Dibben MS Excel MVP On Fri, 23 Feb 2007 05:33:29 -0800, DavidHawes wrote: Hi, I've set up a macro which re-organises an excel spreadsheet into a format that enables me to import the data contained within it directly into an Access database i've set up. This works perfectly. However, I want the macro to delete out any lines of my table (which is fixed in size) that do not contain any data. Is this possible? If so, can someone please explain what code I need to enter to get my macro to do this? Many thanks, David :-) |
#9
Posted to microsoft.public.excel.misc
|
|||
|
|||
MACRO HELP - deleting rows containing a range of blank cells
Hi,
Thanks for the info... This is what I have done but i cannot seem to get the code to work... A couple of lines of the code you detailed are outlined below... DeleteBlankRows ScanRange:=Worksheets("StandardTemplate").Range("A 61:M61") DeleteBlankRows ScanRange:=Worksheets("StandardTemplate").Range("A 60:M60") I think the problem might be related to the fact that data is present in rows "N", "O" and "P". Could this be the case? When i've run the query on a version of the table i'm working on that contains no data, your macro works. When the fields outside of the range I would like to query have data in (which is normally the case), the macro doesn't work. Any assistance could offer would be gratefully appreciated (again!). Many thanks for your assistance (and patience!). Kind regards, David "Chip Pearson" wrote: If you copy the entire procedure and make the modifications I described, the code is in its own procedure. You call that procedure from your own procedure(s). E.g., Sub DeleteBlankRows(ScanRange As Range, Optional WorksheetName As Variant) ' ' My code with revisions. ' End Sub Sub YourCode() ' whatever DeleteBlankRows ScanRange:=Worksheets("Sheet1").Range("A1:A100") ' other code End Sub -- Cordially, Chip Pearson Microsoft MVP - Excel Pearson Software Consulting, LLC www.cpearson.com (email address is on the web site) "DavidHawes" wrote in message ... Should i enter the code from http://www.cpearson.com/excel/deleting.htm in the same macro as the.... DeleteBlankRows ScanRange:=Range("A1:A100") ... function or should this be the code from http://www.cpearson.com/excel/deleting.htm be set up elsewhere? (eg. as a module?) Thanks, David "Chip Pearson" wrote: You can adapt the DeleteBlankRows code on http://www.cpearson.com/excel/deleting.htm to your needs. Specifically, '--------------------------- Change '--------------------------- Sub DeleteBlankRows(Optional WorksheetName As Variant) ' To Sub DeleteBlankRows(ScanRange As Range, Optional WorksheetName As Variant) '--------------------------- Delete '--------------------------- Set Rng = WS.Cells.Find(what:="*", after:=WS.Cells(WS.Rows.Count, WS.Columns.Count), lookat:=xlPart, _ searchorder:=xlByColumns, searchdirection:=xlPrevious, MatchCase:=False) '------------------------ Add: '------------------------ Dim FirstRow As Long '------------------------ Change '------------------------ LastRow = Rng.Row ' To LastRow = ScanRange.Cells(ScanRange.Cells.Count).Row FirstRow = ScanRange(1, 1).Row '------------------------ Change '------------------------ For RowNum = LastRow To 1 Step -1 ' To For RowNum = LastRow To FirstRow Step -1 You can then call this code with a procedure call like Sub DoDelete() DeleteBlankRows ScanRange:=Range("A1:A100") End Sub -- Cordially, Chip Pearson Microsoft MVP - Excel Pearson Software Consulting, LLC www.cpearson.com (email address is on the web site) "DavidHawes" wrote in message ... Just wanted to move this up the forums as my subsequent question (below) would be lost otherwise... --------------------- As an extra, if I wanted to specify a range of cells that, if blank, would result in the deletion of the rows where those cells lie, how would I do this? Thanks again. David "Gord Dibben" wrote: David Try this macro to delete just empty rows. Sub DeleteEmptyRows() ''only if entire row is blank LastRow = ActiveSheet.UsedRange.Row - 1 + _ ActiveSheet.UsedRange.Rows.Count Application.ScreenUpdating = False For r = LastRow To 1 Step -1 If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete End If Next r End Sub Gord Dibben MS Excel MVP On Fri, 23 Feb 2007 05:33:29 -0800, DavidHawes wrote: Hi, I've set up a macro which re-organises an excel spreadsheet into a format that enables me to import the data contained within it directly into an Access database i've set up. This works perfectly. However, I want the macro to delete out any lines of my table (which is fixed in size) that do not contain any data. Is this possible? If so, can someone please explain what code I need to enter to get my macro to do this? Many thanks, David :-) |
#10
Posted to microsoft.public.excel.misc
|
|||
|
|||
MACRO HELP - deleting rows containing a range of blank cells
If you want to check a range on that row:
Option Explicit Sub DeleteEmptyRows() Dim LastRow As Long Dim r As Long LastRow = ActiveSheet.UsedRange.Row - 1 + _ ActiveSheet.UsedRange.Rows.Count Application.ScreenUpdating = False For r = LastRow To 1 Step -1 If Application.CountA(Cells(r, "A").Resize(1, 13)) = 0 Then Rows(r).Delete End If Next r End Sub This checks for empty cells in A:M in the used range--not formulas that evaluate to "" or those formulas that have been converted to values. This line: Cells(r, "A").Resize(1, 13) Is the cell in A1, but resized to a single row (1) and 13 columns (A:M). DavidHawes wrote: Hi, Thanks for this, although it's not quite what i'm after and I can't quite seem to make the code work using the second example you quote... What I require is for a whole row to be deleted if the cells in specified rows within my table (in my case A4:M4, A5:M5, A6:M6 etc) are blank. I tried the following using your example: On Error Resume Next Range("A10:M11").Cells.SpecialCells(xlCellTypeBlan ks) _ .EntireRow.Delete On Error GoTo 0 but this didn't work. Any help would be gratefully appreciated. Many thanks, David Hawes "Dave Peterson" wrote: Option Explicit Sub DeleteEmptyRowsInSelectionIfWholeRowIsEmpty() Dim FirstRow As Long Dim LastRow As Long Dim r As Long Dim myRng As Range Set myRng = Selection.Areas(1).EntireRow.Columns(1) With myRng FirstRow = .Row LastRow = .Rows(.Rows.Count).Row End With Application.ScreenUpdating = False For r = LastRow To FirstRow Step -1 If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete End If Next r End Sub Based on one cell: Option Explicit Sub DeleteEmptyRowsInSelectionIfCellIsEmpty() On Error Resume Next Selection.Areas(1).Columns(1).Cells.SpecialCells(x lCellTypeBlanks) _ .EntireRow.Delete On Error GoTo 0 End Sub DavidHawes wrote: Just wanted to move this up the forums as my subsequent question (below) would be lost otherwise... --------------------- As an extra, if I wanted to specify a range of cells that, if blank, would result in the deletion of the rows where those cells lie, how would I do this? Thanks again. David "Gord Dibben" wrote: David Try this macro to delete just empty rows. Sub DeleteEmptyRows() ''only if entire row is blank LastRow = ActiveSheet.UsedRange.Row - 1 + _ ActiveSheet.UsedRange.Rows.Count Application.ScreenUpdating = False For r = LastRow To 1 Step -1 If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete End If Next r End Sub Gord Dibben MS Excel MVP On Fri, 23 Feb 2007 05:33:29 -0800, DavidHawes wrote: Hi, I've set up a macro which re-organises an excel spreadsheet into a format that enables me to import the data contained within it directly into an Access database i've set up. This works perfectly. However, I want the macro to delete out any lines of my table (which is fixed in size) that do not contain any data. Is this possible? If so, can someone please explain what code I need to enter to get my macro to do this? Many thanks, David :-) -- Dave Peterson -- Dave Peterson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Deleting blank rows | Excel Worksheet Functions | |||
Macro to hide blank cells in a range | Excel Discussion (Misc queries) | |||
Deleting Blank Rows | New Users to Excel | |||
Hide columns & rows that contain "0" or blank in a range of cells | Excel Worksheet Functions | |||
Deleting rows with blank cells | Excel Worksheet Functions |