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

Manju
Manju used Ask the Experts™
on
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?
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Top Expert 2016

Commented:
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
ManjuIT - Project Manager

Author

Commented:
Hi - This works perfectly fine. Just need 1 tweak though. In sheet2, how can i start the data from 2nd row onwards?
Top Expert 2016
Commented:
then 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("A2").PasteSpecial Transpose:=True
For Each c In Rng ' not counting header
    sh.Cells(c.Column+1, 2) = WorksheetFunction.CountA(c.EntireColumn) - 1
Next
End Sub

Open in new window

OWASP Proactive Controls

Learn the most important control and control categories that every architect and developer should include in their projects.

ManjuIT - Project Manager

Author

Commented:
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.
ManjuIT - Project Manager

Author

Commented:
Perfect 10
Subodh Tiwari (Neeraj)Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015

Commented:
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

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial