Code To Delete Columns Containing No Data

[Dazzawm]

I have a massive file, several thousand rows by about 50 columns. Is there a code I can run that will delete all columns that contain no data below header row 2. Otherwise I will have to sort each column individually which will take ages. Thanks.

 

[mumps]

Your code appears to replace a carriage return with a space and then remove the space. Without seeing the contents of the cells, it's difficult for me to see how this is working for you. Again, it would be easier if I could see your actual file. Please refer to my suggestion in Post #7 and if possible upload the file.

 

[Dazzawm]

Try:

Sub DelCols()
    Application.ScreenUpdating = False
    Dim lCol As Long
    lCol = ActiveSheet.UsedRange.Columns.Count
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim x As Long
    For x = lCol To 1 Step -1
        If WorksheetFunction.CountA(Range(Cells(3, x), Cells(LastRow + 1, x))) = 0 Then
            Columns(x).EntireColumn.Delete
        End If
    Next x
End Sub

Hi. Would this code be able to be adapted where it deletes rows rather than columns when there is nothing in them apart from column A? Thanks.

 

[oldbrewer]

name

car

color

alan

ford

red

bill

renault

blue

dave

mazda

red

data after running macro

ed

nissan

blue

fred

fiat

green

harry

ford

blue

ian

ford

green

joe

maserati

yellow

original data

name

car

color

alan

ford

red

bill

renault

blue

colin

dave

mazda

red

ed

nissan

blue

fred

fiat

green

george

harry

ford

blue

ian

ford

green

joe

maserati

yellow

this very simple macro was used

Sub Macro4()

'

' Macro4 Macro

' Macro recorded 10/07/2019 by bob

'

'

10 If Count > 11 Then GoTo 20

For j = 2 To 11

If Cells(j, 2) = "" And Cells(j, 3) = "" Then Rows(j).Select: Selection.Delete Shift:=xlUp: Count = Count + 1: GoTo 10

Next j

20 End Sub

<colgroup><col width="64" span="17" style="width:48pt"> </colgroup><tbody>
</tbody>

 

[Dazzawm]

Thanks but there will be thousands of rows and dozens of columns, how would that affect the code?

 

[oldbrewer]

for j=2 to 50000

I will think about the columns, back in 10 minutes

 

[oldbrewer]

name	car	color	temp1	temp2	temp3	temp4	temp5	temp6	temp7	temp8	temp9	temp10	temp11
alan	ford	red	0.252805	0.663466	0.10949	0.515289	0.86246	0.434814	0.518438	0.790445	0.176519	0.805449	0.528769
dave	mazda	red	0.610851	0.382592	0.648801	0.081524	0.858311	0.68838	0.78857	0.755316	0.170513	0.814876	0.103729
ed	nissan	blue	0.937312	0.554932	0.194509	0.485513	0.435344	0.725568	0.015066	0.172335	0.715557	0.69357	0.764023
harry	ford	blue	0.348505	0.875926	0.68261	0.123773	0.783374	0.73141	0.392251	0.50359	0.966688	0.054632	0.753888
ian	ford	green	0.145497	0.133818	0.43782	0.044723	0.431856	0.464979	0.766229	0.349863	0.218582	0.906632	0.248651
joe	maserati	yellow	0.216465	0.110083	0.332606	0.734377	0.530262	0.911261	0.702072	0.258648	0.397724	0.263118	0.296757
			Sub Macro4()
			'
			' Macro4 Macro
			' Macro recorded 10/07/2019 by bob
			'
			'
			10 If Count > 510 Then GoTo 20
			For j = 2 To 500
			For k = 2 To 50
			If Cells(j, k) <> "" Then GoTo 18 Else GoTo 15
			15 Next k
			Rows(j).Select: Selection.Delete Shift:=xlUp: Count = Count + 1: GoTo 10
			18 Next j
			20 End Sub
	the above code found and deleted two names where all columns were blank
	set the j limit to a bit above your number of rows
	set the k limit to your number of columns
	test
	then set two helper cells that measure the number of rows and columns
	eg set cell BZ1 to =countif(A1:A100000,<>")
	then amend to for j=2 to cells(1,53)

<colgroup><col width="64" span="16" style="width:48pt"> </colgroup><tbody>
</tbody>

 

[mumps]

Try:

Sub DelCols()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim lCol As Long
    lCol = ActiveSheet.UsedRange.Columns.Count
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim x As Long
    For x = LastRow To 2 Step -1
        If WorksheetFunction.CountA(Cells(x, 2).Resize(, lCol - 1)) = 0 Then
            Rows(x).EntireRow.Delete
        End If
    Next x
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

 

[Dazzawm]

Try:

Sub DelCols()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim lCol As Long
    lCol = ActiveSheet.UsedRange.Columns.Count
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim x As Long
    For x = LastRow To 2 Step -1
        If WorksheetFunction.CountA(Cells(x, 2).Resize(, lCol - 1)) = 0 Then
            Rows(x).EntireRow.Delete
        End If
    Next x
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Works perfect thanks mumps. Thanks oldbrewer also for your efforts.

 

[oldbrewer]

I am not in Mumps' class, but I bet I am older than him.........

 

[mumps]

@Dazzawm: You are very welcome. @oldbrewer: I getting up there myself (unfortunately).