remove rows and columns

hello guys

Please write a subroutine that clears the empty rows and columns. After running your codes, you should have a table like the one shown below


Attachment 27785


can u help me
how can i get the first table like the second ?
Ty very much

Homework? Assignment?

Hello,

i am thinking whats best way for your solution. U can do loops to check if range is empty :D and then VBA decide to delete rows or columns.
Note Set rng and arng u can change it not sure do you have small lists or insane huge u can cap it at around 10000 if you never go above 10000 range same for collumns i did locked vba code to BB1 not sure do you go further. Also i saw your list start with 2x empty row so i made one more check for first row is it empty or not at end. and messasge at end u can delete MSGBOX :) have nice day !

Code:

---

Sub kokycar()
Application.ScreenUpdating = False
Dim rng As Range, cell As Range
Set rng = Range("A1:A10000")
For Each cell In rng
cell.Select
If Application.CountA(ActiveCell.EntireRow) = 0 Then
    cell.EntireRow.Delete
End If
Next cell
Dim arng As Range, acell As Range
Set arng = Range("A1:BB1")
For Each acell In arng
acell.Select
If Application.CountA(ActiveCell.EntireColumn) = 0 Then
    acell.EntireColumn.Delete
End If
Next acell
Application.ScreenUpdating = True
If Application.CountA(Range("A1").EntireRow) = 0 Then
    Range("A1").EntireRow.Delete
End If
MsgBox "Done"
End Sub

---

@iivansi2

2 lines of VBA-code suffice.

Man kann keine Zeilen oder Spalten löschen; rows.count und columns.count sind Konstante.

omg you are right i tried to goole it hehe :D

Code:

---

On Error Resume Next 
 Columns("b").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 Rows("1").SpecialCells(xlCellTypeBlanks).EntireColumn.Delete

---

note this macro checks is collumn B empty so if your list is constant and data is like u presented starts in column b it will sort list properly

Sub DeleteRows()

Dim cell As Range

For Each cell In Range("a1:AA350")
If Application.WorksheetFunction.CountA(cell.EntireRow) = 0 Then
cell.EntireRow.Delete
End If
Next cell

End Sub
Sub DeleteColumns()

Dim cell As Range

For Each cell In Range("a1:z340")
If Application.WorksheetFunction.CountA(cell.EntireColumn) = 0 Then
cell.EntireColumn.Delete
End If
Next cell

End Sub
Actually solved with this
Ty very much

Why don't you use the suggestion in #5 ?:crying:

Why don't you use code tags ?

Where did you find this code ? Are you a crossposter ?