Need Excel VBA help to loop in folder, execute several tasks and save filesAs

[Riaaz66]

Hi,

I need urgent help with the following.
I have a MasterWorkbook, where I want to write VBA code that should perform some routine tasks. I know it is a lot but I am kind of lost how to approach this in VBA code.


- The MasterWorkbook macro should process files by looping from a specific folder (this folder differs every month). Let's call these files (all xlsx file format) DataWorkbooks.
- Each DataWorkbook contains 1,2 or 3 sheets (based on a count value in another sheet in the DataWorkbook) from where the dynamic ranges (always Range("A2:O??")) should be copied to 2 sheets in the MasterWorkbook in cell A7.
(I want to use the codename of the sheet because the workbook and sheetname can differ on each DataWorkbook in that folder.)
- When the copying has been done, the DataWorkbook should be closed without saving BUT the MacroWorkbook need to saveAs or Save CopyAs a new filename to another location
- The filename will be based on a cell value (where the filename is specified).
- The original MasterWorkbook should not be saved and remain open.


So to simplify (I hope it is):
1. MasterWorkbook is manually opened. (Macro or VBA code need to be written)
2. Run Macro from MasterWorkbook:
A. Open Specified folder (point folder to open)
B. LOOP in Folder and open each DataWorkbook (xlsx file)
C. On each DataWorkbook GOTO Sheet1, COUNT number of loans in column C, Set Countvalue in MacroWorkbook in Sheet1 Cell "A1)
D. Now - when in Sheet1 cell "A1" the value is 1 THEN
copy FROM DataWorkbook.Sheet3. Dynamic Range A2:O?? TO MacroWorkbook Sheet2.Cell A7

- when in Sheet1 cell "A1" the value is 2 THEN
copy FROM DataWorkbook.Sheet3. Dynamic Range A2:O?? TO MacroWorkbook Sheet2.Cell A7 AND
copy FROM DataWorkbook.Sheet4. Dynamic Range A2:O?? TO MacroWorkbook Sheet3.Cell A7

- when in Sheet1 cell "A1" the value is 3 THEN
copy FROM DataWorkbook.Sheet3. Dynamic Range A2:O?? TO MacroWorkbook Sheet2.Cell A7 AND
copy FROM DataWorkbook.Sheet4. Dynamic Range A2:O?? TO MacroWorkbook Sheet3.Cell A7 AND
copy FROM DataWorkbook.Sheet5. Dynamic Range A2:O?? TO MacroWorkbook Sheet4.Cell A7

- when in Sheet1 cell "A1" the value is > 3 THEN
copy FROM DataWorkbook.Sheet3. Dynamic Range A2:O?? TO MacroWorkbook Sheet2.Cell A7 AND
copy FROM DataWorkbook.Sheet4. Dynamic Range A2:O?? TO MacroWorkbook Sheet3.Cell A7 AND
copy FROM DataWorkbook.Sheet5. Dynamic Range A2:O?? TO MacroWorkbook Sheet4.Cell A7 AND
Create Logfile (with same filename of the DataWorkbook but with "Logfile" as prefix) in TXT format in same location of Specified Folder with message "Contains more than 3


E. When all copying is done, close DataWorkbook with no saving.
F. "SaveAs" or "CopyAs" the MacroWorkbook as "MacroWorkbook_processed & filename [based on MacroWorkbook.Sheet1.Range.("B3").text] & DateTime Now()" (eg. MacroWorkbook_processed_LOAN12345_22022018_14h23m)
BUT!!! The original MacroWorkbook from where the is executing these action should remain the same and open.
G. NEXT DataWorkbook


Can somebody help me with this?

Kind regards,

[Dave]

Hi Riazz. It's Saturday and I'm bored. U have outlined a rather extensive request to be quickly completed by others. It also seems that U are getting paid to complete this task...forum members are not. Generally speaking, forums provide others help with completing specific areas of difficulty that they are having difficulty. Having typed that, like I mentioned I thought that I would provide U with some code to get U started. It will take U to part way through "C" above... being that after that you're request becomes unclear? HTH. Dave

Option Explicit
Sub Test()
Dim Lastrow As Double, sht As Worksheet, Cnt As Double, FSO As Object
Dim FlDr As Object, Fl As Object, FileNm As Object
Set FSO = CreateObject("scripting.filesystemobject")
'***change Folder path/name to your folder path/name
Set FlDr = FSO.GetFolder("YOUR FOLDER PATH AND NAME")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each Fl In FlDr.Files
If Fl.Name Like "*.xlsx" Then
Workbooks.Open Filename:=FileNm
For Each sht In Workbooks(FileNm.Name).Sheets
If sht.Name = "Sheet1" Then
With Sheets(sht.Name)
Lastrow = .Range("C" & .Rows.Count).End(xlUp).Row
MsgBox Fl.Name & " Lastrow of C is: " & Lastrow ' & "  Value: " & .Range("C" & Lastrow).Value
End With
Exit For
End If
Next sht
Workbooks(FileNm.Name).Close SaveChanges:=False
End If
Next Fl
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set FlDr = Nothing
Set FSO = Nothing
Exit Sub
erfix:
On Error GoTo 0
MsgBox "Error"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set FlDr = Nothing
Set FSO = Nothing
End Sub