ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Removing blank columns and rows from worksheet (https://www.excelbanter.com/excel-discussion-misc-queries/181531-removing-blank-columns-rows-worksheet.html)

therrin

Removing blank columns and rows from worksheet
 
Please help in advising a way to remove excess blank columns and rows after
importing from different Operating system.
--
Thanks,

Jim Thomlinson

Removing blank columns and rows from worksheet
 
I assume that you are talking about column and rows after the last populated
data. I also assume that you want a macro solution. Here is some code that I
use (it is in an addin so I can use it on any open workbook)

Public Sub CompactAllSheets() 'Run Me...
On Error GoTo ErrorHandler
Dim wks As Worksheet
Dim blnIsProtected As Boolean
Dim wbk As Workbook

Application.ScreenUpdating = False
Set wbk = ActiveWorkbook
For Each wks In Worksheets
If wks.ProtectContents = True Then
blnIsProtected = True
wks.Unprotect "MyPassword" 'Worksheet password
Else
blnIsProtected = False
End If
Call CompactSheet(wks)
If blnIsProtected = True Then wks.Protect "MyPassword"
Next wks
Application.ScreenUpdating = True

If MsgBox("For the compact to complete the spreadsheet must be saved. "
& _
"Do you want to save now?", vbYesNo + vbInformation, "Save?") = vbYes
Then wbk.Save
End Sub


Public Sub CompactSheet(Optional ByVal wks As Worksheet)
Dim rng As Range

If wks Is Nothing Then Set wks = ActiveSheet
Set rng = LastCell(wks)
wks.Range(rng.Offset(0, 1), wks.Cells(1,
Columns.Count)).EntireColumn.Delete
wks.Range(rng.Offset(1, 0), wks.Cells(Rows.Count, 1)).EntireRow.Delete

End Sub


Public Function LastCell(Optional ByVal wks As Worksheet) As Range
Dim lngLastRow As Long
Dim intLastColumn As Integer

If wks Is Nothing Then Set wks = ActiveSheet
On Error Resume Next
lngLastRow = wks.Cells.Find(What:="*", _
After:=wks.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
intLastColumn = wks.Cells.Find(What:="*", _
After:=wks.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
If lngLastRow = 0 Then
lngLastRow = 1
intLastColumn = 1
End If
Set LastCell = wks.Cells(lngLastRow, intLastColumn)

End Function
--
HTH...

Jim Thomlinson


"therrin" wrote:

Please help in advising a way to remove excess blank columns and rows after
importing from different Operating system.
--
Thanks,



All times are GMT +1. The time now is 05:55 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com