Solved: Delete Column if row is blank

[Emoncada]

I have multple spreadsheets that have data with column headers.
I would like for a script to look at row 2 of each column from A:W, and if it's empty to delete the entire column.

Now that is the first part.
After that is done I should just have a few columns with data in row 2 and possibly more rows.

I need to look at the second column (B) and cut from row 1 to the last row of data and paste it in column (A) leaving a row empty. And continue to do this with all columns with data in row 2.

So I should have all the data from the columns now in Column A


Can this be done?

[mancubus]

does this help?

[vba]
Sub DelColsBlnkCll()

Dim ws As Worksheet
Dim Col As Long, LastCol As Long

With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
Calc = .Calculation
.Calculation = xlCalculationManual
End With

For Each ws In Worksheets
With ws
LastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
For Col = LastCol To 1 Step -1
If Trim(.Cells(2, Col).Value) = "" Then .Columns(Col).EntireColumn.Delete
Next
.Columns(1).EntireColumn.Delete
'column B cut from row 1 to the last row of data and paste it in column A
.Rows(1).EntireRow.Insert
'leaving a row empty
End With
Next

With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
.Calculation = Calc
End With

End Sub
[/vba]

[Emoncada]

hi mancubus, thanks for the quick reply.
Your script does delete the columns without a value in row 2 with exception to the last column.
Also it does not put the values in column A instead it's just moving all the values down 1 row so row 1 is all blank and headers are in row 2

[mancubus]

you're wellcome.

and i'm sorry, i completely misunderstood the requirement.

give this a try:
[VBA]
Sub DelColsBlnkCllThenMove()

Dim ws As Worksheet
Dim moveRng As Range, destRng As Range
Dim Calc as Long, Col As Long, LastCol As Long

With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
Calc = .Calculation
.Calculation = xlCalculationManual
End With

For Each ws In Worksheets
With ws
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For Col = LastCol To 1 Step -1
If Trim(.Cells(2, Col).Value) = "" Then .Columns(Col).EntireColumn.Delete
Next
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
If LastCol = 1 Then Exit Sub
For Col = 2 To LastCol
Set destRng = .Cells(.Rows.Count, "A").End(xlUp).Offset(2, 0)
Set moveRng = .Range(.Cells(1, Col), .Cells(.Cells(.Rows.Count, Col).End(xlUp).Row, Col))
moveRng.Cut Destination:=destRng
Next
End With
Next

With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
.Calculation = Calc
End With

End Sub
[/VBA]

[Emoncada]

looks good, but I noticed it does it for all the spreadsheets, can i have just do this on active sheet?

[mancubus]

hey.
this was not a part of the misunderstanding.

I have multple spreadsheets that have data with column headers.

[vba]
Sub DelColsBlnkCllThenMove()

Dim moveRng As Range, destRng As Range
Dim Calc As Long, Col As Long, LastCol As Long

With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
Calc = .Calculation
.Calculation = xlCalculationManual
End With

With ActiveSheet
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For Col = LastCol To 1 Step -1
If Trim(.Cells(2, Col).Value) = "" Then .Columns(Col).EntireColumn.Delete
Next
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
If LastCol = 1 Then Exit Sub
For Col = 2 To LastCol
Set destRng = .Cells(.Rows.Count, "A").End(xlUp).Offset(2, 0)
Set moveRng = .Range(.Cells(1, Col), .Cells(.Cells(.Rows.Count, Col).End(xlUp).Row, Col))
moveRng.Cut Destination:=destRng
Next
End With

With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
.Calculation = Calc
End With

End Sub
[/vba]

[Emoncada]

yes your right, only thing is this is a spreadsheet that gets added to on a weekly basis. so it would be better to select which one we need at that time and not redo one's that have previously been done.

[Emoncada]

This looks good mancubus Thanks

[mancubus]

you're wellcome.
glad it helped...