-1

Is there any faster process using vb script to delete an Excel column if that column contains not a single value in it?

   For Task=2 To 300

   Vcounter="False"
   IntRow6=2

   Do While objSheet6.Cells(IntRow6,1).Value = ""

  If objSheet6.Cells(IntRow6,Task).Value <> "" Or objSheet6.Cells(IntRow6,Task).Value <> "None"


   Vcounter="True"
   Exit DO

  End If

 IntRow6=IntRow6+1
 Loop

  If  Vcounter <> "True" Then

   objSheet6.Cells(1,Task).EntireColumn.Delete

  End If

 Next

Update:

Could you also say how to count the number of data in each Row of an Excel? for e.g.

        Col1   Col2  Col3   Col4   Col5
   
  Row1   A       B            X     P
  Row2   L       M
  Row3                 T            V

Now the VBScript should give me the count that Row1 contains 4 data,Row2 contains 2 data and Row3 contains 2 data like wise .

Code Update

I have updated my code with reference to your one. And used "Hi" as an pop-up box to see if the controls entered into the If Body.But the popup never came. It seems something wrong happened in the call "Application.WorksheetFunction.CountBlank(rg)". Can you check and help me here? None of the columns have been deleted,where they should be.

Sub DeleteColumns(Ob6)
     Dim CountBlank 
     Dim rows 
     Dim rg,c
  Set objExcel1 = CreateObject("Excel.Application")

 For c = 150 To 155
    Set rg = Ob6.Range(Ob6.Columns(c),Ob6.Columns(c))
    CountBlank = objExcel1.Application.WorksheetFunction.CountBlank(rg)
    rows = rg.rows.Count

    If CountBlank = rows Then
        MsgBox("Hi")
        rg.EntireColumn.Delete
    End If
 Next
End Sub

Fix: I just fixed it.So no trouble here. just need your help for the Update part.

Sunderam Dubey
  • 1
  • 11
  • 20
  • 40
Arup Rakshit
  • 116,827
  • 30
  • 260
  • 317

2 Answers2

2

You can use the function CountBlank, found inside Application.WorksheetFunction

Dim CountBlank As Long
CountBlank = Application.WorksheetFunction.CountBlank(Range("A:A"))

Then, you just need to compare it to the number of rows in the same range:

Dim ws As Worksheet
Dim rows As Long
Set ws = ThisWorkbook.Worksheets(1)
rows = ws.Range("A:A").Count

The entire code for deleting an empty column, from the index 1 to 300, would look like this:

Sub DeleteColumns()
    Dim CountBlank As Long
    Dim ws As Worksheet
    Dim rows As Long
    Set ws = ThisWorkbook.Worksheets(1)
    Dim rg As Range

    For c = 1 To 300
        Set rg = Range(ws.Columns(c), ws.Columns(c))
        CountBlank = Application.WorksheetFunction.CountBlank(rg)
        rows = rg.rows.Count

        If CountBlank = rows Then
            rg.EntireColumn.Delete
        End If
    Next
End Sub
  • Thanks for your reply.I didn't get your point.Can you bit help me here to understand the same? – Arup Rakshit Dec 11 '12 at 13:33
  • In My Excel i do have 300 columns,onto which i need to check if that column has any single data or not. So i can provide only the column number instead of the Alphabet in the Range object.So any idea how to do so? – Arup Rakshit Dec 11 '12 at 14:58
  • Hi - I've posted the final code for you (columns selected via indexes). Hopefully I undestood it right and you are trying to delete columns without values in its cells. Otherwise, you can tweak the code a bit to do whatever you want. – Dennis C Furlaneto Dec 11 '12 at 16:10
  • can you help in my below post ? http://stackoverflow.com/questions/13823912/to-move-the-cell-values-in-a-group-from-right-to-left-if-any-group-of-cells-are – Arup Rakshit Dec 11 '12 at 17:47
  • Can you also help me in my updated part in the post of above? thanks in advance – Arup Rakshit Dec 12 '12 at 02:25
0

Your idea was perfect,except a bit change that i made in the code. We need to use the Decrement For Loop,instead of Increment Loop. Otherwise not all the columns would be deleted by the Delete function. here the changed and updated code is:

Sub DeleteColumns(Ob6)
  Dim CountBlank 
  Dim rows 
  Dim rg,c

  For c = 155 To 150 step - 1
    Set rg = Ob6.Range(Ob6.Columns(c),Ob6.Columns(c))
    CountBlank = objExcel1.Application.WorksheetFunction.CountBlank(rg)
    rows = rg.rows.Count
         'MsgBox("CountBlank:"&CountBlank)
         'MsgBox("Count:"&rows)
    If CountBlank = (rows-1) Then ' Rows-1 means the count should start from the 2nd row onward

        rg.EntireColumn.Delete

    End If
 Next

End Sub
Arup Rakshit
  • 116,827
  • 30
  • 260
  • 317