Coding not works sometime

[Rakesh]

I got the below coding from this forum.
The macro delete the Blank columns.

Sub del_blank_column()

Dim sh As Worksheet
Dim Lastcol As Long
Dim i As Long

Application.ScreenUpdating = False

For Each sh In ActiveWorkbook.Worksheets

With ActiveSheet

Lastcol = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Column

For i = Lastcol To 2 Step -1

If .Cells(3, i).Value = "" Then

.Columns(i).Delete
End If
Next i
End With
Next sh

Application.ScreenUpdating = True
End Sub

This work for some files and not for some files.

See attached file which the macro doesn’t works.

If anybody helps to fix it. It would be greatly appreciated.

And one more help needed. How to delete the white text from the worksheets using vba.

Thanks,
Rakesh

[mancubus]

it seems cells in row 7 (rather than 3) must be checked...


Sub del_blank_column()

Dim sh As Worksheet
Dim LastCol As Long
Dim i As Long

Application.ScreenUpdating = False

For Each sh In ActiveWorkbook.Worksheets
With sh
If Application.CountA(.Cells) > 0 Then 'added for blank worksheets
LastCol = .Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
For i = LastCol To 2 Step -1
If .Cells(7, i).Value = "" Then 'cells in row 7
.Columns(i).Delete
End If
Next i
End If
End With
Next sh

Application.ScreenUpdating = True

End Sub

[SamT]

In Workbook Sample, The Lastcol = 1.

This line of code does not run
For i = Lastcol To 2 Step -1

[mohanvijay]

.Cells(3, i).Value = ""


from above line "3" indicates 3rd row inattached file heading started in 7 row

for delete columns you can also use below code



Dim a As Range

Set a = Range("c7:" & Cells(7, Cells(7, Columns.Count).End(xlToLeft).Column).Address).SpecialCells(xlCellTypeBlanks )

a.EntireColumn.Delete

Set a = Nothing

[Rakesh]

it seems cells in row 7 (rather than 3) must be checked...

If .Cells(7, i).Value = "" Then 'cells in row 7


Changing the Cell number everytime according to the workbook will be a burden.

Rather than that How to delete the columns, if entire column is blank?

[mancubus]

Sub del_blank_column()

Dim sh As Worksheet
Dim LastCol As Long
Dim i As Long

Application.ScreenUpdating = False

For Each sh In ActiveWorkbook.Worksheets
With sh
If Application.CountA(.Cells) > 0 Then 'added for blank worksheets
LastCol = .Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
For i = LastCol To 1 Step -1
If Application.CountA(.Columns(i)) = 0 Then
.Columns(i).Delete
End If
Next i
End If
End With
Next sh

Application.ScreenUpdating = True

End Sub

[Rakesh]

Thanks,

Its working Fine.

How to deleted the white text from the worksheets using vba?

[jolivanes]

You could try this on a copy of your workbook


Sub Try_This()
Dim c As Range
For Each c In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row) '<--- Adjust range to check
If c.Font.Color = RGB(255, 255, 255) Then c.ClearContents
Next c
End Sub

[Rakesh]

HI jolivanes,

It coding works fine. But it deletes, when a whole cell contains white text, whereas if the cell contain partially white text it doesn't.

One more help.

Rather defining the Range, How to make it for the whole workbook?

Thanks,
Rakesh

[jolivanes]

Sub Try_This_A()
Dim c As Range, wsh As Worksheet
For Each wsh In ActiveWorkbook.Worksheets
For Each c In wsh.Range("A1").CurrentRegion
If c.Font.Color = RGB(255, 255, 255) Then c.ClearContents
Next c
Next wsh
End Sub

[Rakesh]

If the cell contains partially white text it is not deleted.

[jolivanes]

This is the only way I know how to do it.

Sub Try_This()
Dim c As Range, wsh As Worksheet, i As Long
Application.ScreenUpdating = False
For Each wsh In ActiveWorkbook.Worksheets
For Each c In wsh.Range("A1").CurrentRegion
For i = 1 To Len(c)
If c.Characters(i, 1).Font.Color = RGB(255, 255, 255) Then c.ClearContents
Next i
Next c
Next wsh
Application.ScreenUpdating = True
End Sub