VBA Merge specific sheets from files in a folder

[jskasango]

VBA Merge specific sheets from files in a folder. I want my sheets to be merged into ONE sheet after matching the column headers. If its ok with you, column A can contain the source file name. Thanks in advance.

 

[maabadi]

For adding Label for fileName Do Step By step:
1. At Properties window Change Name to FileNam & BackColor to Yellow or .... (select from Pallete) & Caption to ====
2. if you want Change Other Properties:
- I wide it to approximate 300px width & 30px Height)
- I Change Font To TimesNewRoman & Bold It
- I Change Font size to 16 & Textalign to 2-fmTextalignCenter
Go to Importfiles3 code and after this 3 line

Do While FileName <> ""
Workbooks.Open FileName:=FolderPath & FileName, ReadOnly:=True
xStrAWBName = ActiveWorkbook.Name

Add this line

UserForm1.FileNam.Caption = Left(xStrAWBName, Application.WorksheetFunction.Find(".", xStrAWBName) - 1)

Note: Label name and second part of this line code must be same. ( here FileNam)

 

[jskasango]

if you want to move progress indicator to ribbon :
1. At Developer Tab , go to Design mode & Delete commandbutton.
2. Go to VBA window and Insert New Module and Paste this code:

Sub ProgressIndicator()
UserForm1.Show
End Sub

3. At excel window, right click on ribbon and select Customize the ribbon
4. At the Choose command from Section select Macros. & Find and Select ProgressIndicator Macro.
5. At the Main Tab section, Select Tab you want Insert Macro.
6. At the Bottom right, press New Group (and if want Rename it)
7. Press add button at the middle to your macro added to ribbon at selected Tab.

I am so happy with the outcome that I have chosen the smiling emoji for the Process indicator on the excel menu.
1). May I now keep the .xlm file hidden like the Personal.xlm?
2). Is there a way I can package all this and share with as a single file with anybody who is interested to use it the way I am using it, to save them the technicalities of what we have gone through?

Thank you very very much!

 

[maabadi]

1). May I now keep the .xlm file hidden like the Personal.xlm?

Total file not. But macros within it yes (userforms not). If you don't See Personal Macro workbook,
1. From excel window at Developer tab, select Record macro, and Then store macro in Personal Macro workbook & OK & and 1 -2 action and stop it.
2. Go to VBA window , Personal Macro workbook, Drag your macros you want to it.

2). Is there a way I can package all this and share with as a single file

Yes. You can sent your excel file to anybody
But if you say Package as One macro, I don't think. No. Because anybody should add userform & Labels to See Progress Indicator & do editing them (resize, give labels & .... )

 

[jskasango]

What line of code can be written so that after all the Master sheets have been merged, just before saveas CSV or immediately after, if column DX is empty, DELETE ROW? from row 3 downwards up to the end.

 

[maabadi]

if column DX is empty, DELETE ROW?

I think you want to Tell Delete Column.

After this Line

UserForm1.UnloadThisForm

Add this code

LCD = DestSheet.Cells(1, Columns.Count).End(xlToLeft).Column
For i = LCD To 1 Step -1
Lr = DestSheet.Cells(Rows.Count, i).End(xlUp).Row
If  Lr < 3  Then Columns(i).Delete
Next i

 

[jskasango]

I think you want to Tell Delete Column.

After this Line

UserForm1.UnloadThisForm

Add this code

LCD = DestSheet.Cells(1, Columns.Count).End(xlToLeft).Column
For i = LCD To 1 Step -1
Lr = DestSheet.Cells(Rows.Count, i).End(xlUp).Row
If  Lr < 3  Then Columns(i).Delete
Next i

I want to delete the row not the column. This is the merged MASTERStack and column DX contains planting date. If that cell DX is empty, it means not planted, so delete! This will remove all the files that merged without any data. Thanks for understanding!

 

[jskasango]

For all ROWS starting from Row 3, check if the cell in Row n COL DX is empty, if empty, DELETE! Voila. Then I can sleep well.

 

[maabadi]

Then Try this:

  Lr = DestSheet.Cells(Rows.Count, i).End(xlUp).Row
For i = Lr To 3 Step -1
If  DestSheet.Cells(i, 128).Value = ""  Then DestSheet.Rows(i).Delete
Next i

 

[jskasango]

Then Try this:

  Lr = DestSheet.Cells(Rows.Count, i).End(xlUp).Row
For i = Lr To 3 Step -1
If  DestSheet.Cells(i, 128).Value = ""  Then DestSheet.Rows(i).Delete
Next i

Here is the error:

Now trying the second option.
Second option same error

 

[maabadi]

Try:

Dim i as Long
Lr = DestSheet.Cells(Rows.Count, i).End(xlUp).Row
For i = Lr To 3 Step -1 
If  DestSheet.Cells(i, 128).Value = ""  Then DestSheet.Rows(i).Delete
Next i