asked on

VBA - Loop Each header to get non blank cells and paste result

Experts - I have alot of data in "Sheet1". Now, I have 615 columns. this may increase / decrease in future.

Is there any macro which can create a new "Sheet2" next to "Sheet1", copy all headers from Sheet1(first row) and paste it in transverse in "Sheet2" and give me the non blank counts for each column?

Rgonzo1971

Hi,

pls try

Sub macro()
Sheets("Sheet1").Activate
Set Rng = Range(Range("A1"), Cells(1, Columns.Count).End(xlToLeft))
Rng.Copy
Sheets.Add after:=Sheets("Sheet1")
Set sh = ActiveSheet
sh.Range("A1").PasteSpecial Transpose:=True
For Each c In Rng ' not counting header
    sh.Cells(c.Column, 2) = WorksheetFunction.CountA(c.EntireColumn) - 1
Next
End Sub

Open in new window

Regards

Manju

ASKER

Hi - This works perfectly fine. Just need 1 tweak though. In sheet2, how can i start the data from 2nd row onwards?

ASKER CERTIFIED SOLUTION

Rgonzo1971

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Manju

ASKER

Apologies again:

Worksheets(1).Activate
Set Rng = Range(Range("A1"), Cells(1, Columns.Count).End(xlToLeft))
Rng.Copy
Sheets.Add after:=Worksheets(1)
Set sh = ActiveSheet
sh.Range("A2").PasteSpecial Transpose:=True
For Each c In Rng ' not counting header
sh.Cells(c.Column + 1, 2) = WorksheetFunction.CountA(c.EntireColumn) - 1
Next

I changed the sheet1 to worksheets(1) as the name of the sheet will change from file to file. but i get class error.

Manju

ASKER

Perfect 10

Subodh Tiwari (Neeraj)

You may also give it a try...

Sub CountDataInColumns()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lc As Long, c As Long, r As Long
Set ws1 = Sheets("Sheet1")

On Error Resume Next
Set ws2 = Sheets("ValueCount")
ws2.Cells.Clear
On Error GoTo 0

If ws2 Is Nothing Then
    Set ws2 = Sheets.Add(after:=ws1)
    ws2.Name = "ValueCount"
End If

lc = ws1.Cells(1, Columns.Count).End(xlToLeft).Column
r = 2
For c = 1 To lc
   ws2.Cells(r, 1) = ws1.Cells(1, c)
   ws2.Cells(r, 2) = Application.CountA(ws1.Columns(c))
   r = r + 1
Next c
End Sub

Open in new window