Remove Column if Blank

[Vishaal]

Hi and thanks,

pls check the following sheet, want to remove all the blank column

Excel 2010 32 bit

	B​	C​	D​	E​	F​	G​	H​	I​	J​	K​	L​	M​	N​	O​
1​	Name​	Attend 1​	Attend 2​	Attend 3​	Attend 4​	Attend 5​	Attend 6​	Attend 7​	Attend 8​	Attend 9​	Attend 10​	Attend 11​	Attend 12​	Attend 13​
2​	John​	​	​	​	​	P​	​	P​	​	​	​	P​	​	​
3​	​	​	​	​	​	P​	​	P​	​	​	​	P​	​	​
4​	​	​	​	​	​	P​	​	P​	​	​	​	P​	​	​
5​	​	​	​	​	​	​	​	​	​	​	​	​	​	​
6​	Raghu​	P​	​	​	​	​	​	P​	​	​	​	​	​	​
7​	​	P​	​	​	​	​	​	P​	​	​	​	​	​	​
8​	​	P​	​	​	​	​	​	P​	​	​	​	​	​	​
9​	​	​	​	​	​	​	​	​	​	​	​	​	​	​
10​	Matty​	​	​	​	​	​	​	P​	​	​	P​	​	​	P​
11​	​	​	​	​	​	​	​	P​	​	​	P​	​	​	P​
12​	​	​	​	​	​	​	​	P​	​	​	P​	​	​	P​

Sheet: Sheet1

result sheet

Excel 2010 32 bit

	B​	C​	D​	E​	F​	G​	H​
1​	Name​	Attend 1​	Attend 5​	Attend 7​	Attend 10​	Attend 11​	Attend 13​
2​	John​	​	P​	P​	​	P​	​
3​	​	​	P​	P​	​	P​	​
4​	​	​	P​	P​	​	P​	​
5​	​	​	​	​	​	​	​
6​	Raghu​	P​	​	P​	​	​	​
7​	​	P​	​	P​	​	​	​
8​	​	P​	​	P​	​	​	​
9​	​	​	​	​	​	​	​
10​	Matty​	​	​	P​	P​	​	P​
11​	​	​	​	P​	P​	​	P​
12​	​	​	​	P​	P​	​	P​

Sheet: Sheet1

help pls

 

[mumps]

Try:

Sub DelBlankCols()
    Application.ScreenUpdating = False
    Dim lCol As Long, x As Long
    lCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    For x = lCol To 1 Step -1
        If Cells(2, x) = "" Then
            Columns(x).Delete
        End If
    Next x
    Application.ScreenUpdating = True
End Sub

 

[Vishaal]

tried with same data but not working

 

[mumps]

How is it not working? I tried it on the data you posted and it worked properly. The only thing in the macro I would change is

For x = lCol To 1 Step -1

to

 For x = lCol To 2 Step -1

so that column A is not deleted. Do you get an error message and if so, what is the message and which line of code is highlighted when you click "Debug"?

 

[Vishaal]

Thanks for your support "mumps"

we have tried it again on different system and use same data, code run but not getting the result as show in thread #1, may i upload a excel file here so that you can check, from which website we can upload data, help pls

 

[Vishaal]

we have tried it with other available codes from online also, but don't know where is the problem

we are using excel 2010

pls upload the book or advice how can we show the file

 

[Michael M]

Where did you paste the provided code ??

 

[Akuini]

we have tried it with other available codes from online also, but don't know where is the problem

we are using excel 2010

pls upload the book or advice how can we show the file

You can upload your sample workbook (without sensitive data) to a free site such as dropbox.com & then put the link here.
It looks like the blank cell isn't really blank but has a unicode character.
Try this:
1. select an empty cell in your data set
2. run this code:
Sub try91()
MsgBox WorksheetFunction.Unicode(ActiveCell)
End Sub

what is the message?
when I tried it it says: 8203

 

[Michael M]

Maybe try it this way

Sub MM1() Application.ScreenUpdating = False Dim lCol As Long, x As Long, lr As Long lr = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row lCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column For x = lCol To 1 Step -1 If WorksheetFunction.CountA(Range(Cells(2, x), Cells(lr, x))) = 0 Then Columns(x).Delete End If Next x Application.ScreenUpdating = True End Sub

 

[Akuini]

Try this:

Sub a1116095a()
    Dim xCol As Long, n As Long
    Application.ScreenUpdating = False
    'remove the unicode ChrW(8203)
    Cells.Replace What:=ChrW(8203), Replacement:="", LookAt:=xlPart
    
    xCol = Cells(1, Columns.Count).End(xlToLeft).Column
    For n = xCol To 2 Step -1
       If Cells(Rows.Count, n).End(xlUp).Row = 1 Then Columns(n).Delete
    Next n
    Application.ScreenUpdating = True
End Sub

The result:

Book1
	A	B	C	D	E	F	G	H
1		Name	Attend 1	Attend 5	Attend 7	Attend 10	Attend 11	Attend 13
2		John		P	P		P
3				P	P		P
4				P	P		P
5
6		Raghu	P		P
7			P		P
8			P		P
9
10		Matty			P	P		P
11					P	P		P
12					P	P		P
Sheet5