HI VBA Guru
I have several large reports (over 200 columns in each) and all columns have headings. However 75% of the columns do not have any subsequent data i.e cells from Row 2 to the end of report are blanks. The blank columns are between other columns that have data and I want to retain them. I have searched on various sites but could not find anything suitable. I have come across the following code. I have very little knowledge of VBA.
Since I will have to repeat this exercise several times I do not want to add codes to each file. What I want is to have an Excel template whereby to have 3 fields on worksheet called “MACRO_RunCode”. These are as follows:-
FILE PATH: where user will insert full path of file - say in cell E14
FILE NAME: where user will insert the name of the file - say in cell E16
WORKSHEET NAME: where user will insert the name of the worksheet in each file - say in cell E18
This worksheet will also contains the button that when clicked will run appropriate code to delete columns that have headings only and other cells are blanks.
In addition I want to make this code useable for .xls OR xlsx files depending on what version of Excel one uses.
Please can someone help modify this code:
1. Sub Delete_Blanks()
2. DIM myFile as String
3. DIM myPath as String
4. DIM myWorksheet as String
5. DIM xlApp as String
6. DIM xcelVersion as Variant
7. ‘Open Excel Application
8. Set xlApp = CreateObject (“Excel Application”)
9. objExcel.Visible = True
10. ‘Set Objects
11. Set myPath = CreateObject .Range (“E14”) ‘Path as stated in cell E14
12. Set myFile = ObjExcel.Workbooks.Open (“E16”) ‘File Name as stated in cell E16
13. Set myWorksheet = Sheets("E18").Visible = True ‘Worksheet Name as stated in cell E18
14.
15. Sheets("Sheet1").Select
16. Range("A1").Select
17. LastRow = ActiveSheet.UsedRange.Row - 1 + _
18. ActiveSheet.UsedRange.Rows.Count
19. Application.ScreenUpdating = False
20. For r = LastRow To 1 Step -1
21. If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
22. Next r
23. LastColumn = ActiveSheet.UsedRange.Column - 1 + _
24. ActiveSheet.UsedRange.Columns.Count
25. Application.ScreenUpdating = False
26. For c = LastColumn To 1 Step -1
27. If Application.CountA(Columns(c)) = 0 Then Columns(c).Delete
28. Next c
29. End Sub
I am attaching sample file
Thanking you in advance
Dhiresh
Bookmarks