To delete unused rows in Excel spread sheet. 1

[bnageshrao]

I created a blank spreadsheet with 1000 lines for end users. They are going to input all the data and click a button to save it as a text file. I wrote the macro for this portion and it works fine. I want to know whether som one knows the code to delete all the unused rows in this spread sheet because end users can use only 100 or 200 or 349 or 672 rows. Can a macro be written to automatically delete all the unused rows. Any help is highly appreciated.

 

[Klae]

Do you want not have the empty rows in the text file or actually delete them from the sheet?

 

[bnageshrao]

The main idea is not to have unused rows in text file since the text file will be used as an input file for some other program. So if I can achieve this when I save my file as text file, that is all I need and if you can tell me about this I will be thankful.

 

[Klae]

OK I'm working on it. DarkSun might help out

 

[Klae]

Hi,

This is something I've knocked up quickly in case I'm on the wrong idea but the first example will only write to your text file if it's not an empty row. (I thinkthis is what you want)

Dim isEmptyRow As Boolean

isEmptyRow = False

    For i = 1 To 1000
        For j = 1 To 26
         If Worksheets("Sheet1").Cells(i, j).Value = "" Then
             isEmptyRow = True
         Else
             isEmptyRow = False
             Exit For
         End If
        Next
        If Not isEmptyRow Then
            [COLOR=green]Write to text file code[/color]
        End If
        isEmptyRow = False
    Next

The second example is slightly different it will delete an empty row it comes across (I don't think this is what you want).

Dim isEmptyRow As Boolean

isEmptyRow = False

    For i = 1 To 10
        For j = 1 To 26
         If Worksheets("Sheet1").Cells(i, j).Value = "" Then
             isEmptyRow = True
         Else
             isEmptyRow = False
             Exit For
         End If
        Next
        If isEmptyRow Then
            Worksheets("Sheet1").Rows(i).Delete
        End If
        isEmptyRow = False
    Next

Where I use

1000

this is the number of rows it cycles through and when I use

26

this is the number of columns I cycle through. Obviously change to the range of rows or columns you want.

 

[bnageshrao]

I liked the second method and it works great except for one hitch. Let us say that I have 25 rows with row number 5, 6 and 10 being empty. First it will find row 5 and delete it. Then looks like the original row number 6 will now become 5 and 7 will become 6 where as our i = 1 to 25 counter now is set to 6 and it reads row number 6 which will not be empty. I am thinking about this meanwhile if you have any idea please let me know, thanks in advance.

 

[bnageshrao]

Hi klae
I started checking rows from bottom and then deleting it, and your program works fine and thanks a lot.

 

[gtdown]

How do you start from the bottom?

 

[xlbo]

To start from the bottom, use
For i = 1000 to 1 step -1

HTH
Geoff

 

[scooby2]

Sub ClearExcessRowsAndColumns()

Dim intLRow As Integer, intLCol As Integer, intRowCount As Integer
Dim i As Integer, intLCell As Integer, wksWKS As Worksheet
Dim blProtCont As Boolean, blProtScen As Boolean, blProtDO As Boolean
Dim myRange As Range
Dim myLastline As Range


On Error GoTo errHandler
'Loop through each worksheet in the workbook.
For Each wksWKS In ActiveWorkbook.Worksheets
Application.StatusBar = "Finding Data Boundaries for " & _
ActiveWorkbook.Name _
& "!" & wksWKS.Name & ", Please Wait..."
'Store worksheet protection settings and unprotect if protected.
blProtCont = wksWKS.ProtectContents
blProtDO = wksWKS.ProtectDrawingObjects
blProtScen = wksWKS.ProtectScenarios
wksWKS.Unprotect ""
'Determine the last cell that Excel finds and determine its row.
'If it is greater than 8192, limit the rows for variable memory
'overload.

If wksWKS.Cells.SpecialCells(xlLastCell).Row > 8192 Then
'Last row for Lotus files is 8192.
intRowCount = 8192
Else
intRowCount = wksWKS.Cells.SpecialCells(xlLastCell).Row
End If
'Loop through each row and determine the last cell with data.
intLCell = 0
intLCol = 0
For i = 1 To intRowCount
intLCell = wksWKS.Cells(i, 255).End(xlToLeft).Column
If intLCell > intLCol Then intLCol = intLCell
Next i
'Loop through the columns and determine the last cell with data.
intLCell = 0
intLRow = 0
For i = 1 To wksWKS.Cells.SpecialCells(xlLastCell).Column
intLCell = wksWKS.Cells(8194, i).End(xlUp).Row
If intLCell > intLRow Then intLRow = intLCell
Next i
'Delete the Excess rows and columns.
wksWKS.Range(wksWKS.Columns(intLCol + 1), _
wksWKS.Columns(255)).Delete
wksWKS.Range(wksWKS.Rows(intLRow + 1), _
wksWKS.Rows(wksWKS.Rows.Count)).Delete
'Reset protection.
wksWKS.Protect "", blProtDO, blProtCont, blProtScen
Next wksWKS

errHandler:
MsgBox "An error occurred." & Chr(13) & Err.Number & " " & _
Err.Description, vbCritical
End Sub