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?
LVL 7
ManjuIT - Project ManagerAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rgonzo1971Commented:
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
0
ManjuIT - Project ManagerAuthor Commented:
Hi - This works perfectly fine. Just need 1 tweak though. In sheet2, how can i start the data from 2nd row onwards?
0
Rgonzo1971Commented:
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

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Microsoft Azure 2017

Azure has a changed a lot since it was originally introduce by adding new services and features. Do you know everything you need to about Azure? This course will teach you about the Azure App Service, monitoring and application insights, DevOps, and Team Services.

ManjuIT - Project ManagerAuthor 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.
0
ManjuIT - Project ManagerAuthor Commented:
Perfect 10
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
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

0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.