Solved: VBA for updating every worksheet in workbook.

[Shums]

Hi,

Every day I am downloading data in one specific folder, which comes in csv format with today's date, which means it changes everyday.

Now I have 25 workbook each contains 20-30 worksheets, anyhow I manage to get a VBA code for updating every worksheet with below code:

My problem is: I have to open every workbook go to each sheet and run this macro, I would request you to help me out in updating all the worksheet with one command. Secondly if I have 20 sheets in workbook this macro runs very slow, is there any possibility for speeding up.

Your assistance will make my life more easier.


Sub Updates()

Dim n As Long, k As Long
Application.ScreenUpdating = True
Range(ActiveCell, ActiveCell.Offset(Val(1) - 1, 0)).EntireRow.Insert

k = ActiveCell.Offset(-1, 0).Row
n = Cells(k, 83).End(xlToLeft).Column
Range(Cells(k, 83), Cells(k + Val(1), n)).FillDown

With ActiveCell
.Value = Format(Date, "dd-mmm-yy")
.Offset(0, 1).Value = "MH"
End With

Dim SheetName As String
Dim ActiveDate As String

PathO = "C:\Bhav Copy\"

SheetName = ActiveSheet.Name

ActiveDate = Cells(ActiveCell.Row, 1)
DD = Mid(ActiveDate, 1, 2)
MM = Mid(ActiveDate, 4, 3)
YY = Mid(ActiveDate, 8, 2)
If MM = "Jan" Then MMO = "01"
If MM = "Feb" Then MMO = "02"
If MM = "Mar" Then MMO = "03"
If MM = "Apr" Then MMO = "04"
If MM = "May" Then MMO = "05"
If MM = "Jun" Then MMO = "06"
If MM = "Jul" Then MMO = "07"
If MM = "Aug" Then MMO = "08"
If MM = "Sep" Then MMO = "09"
If MM = "Oct" Then MMO = "10"
If MM = "Nov" Then MMO = "11"
If MM = "Dec" Then MMO = "12"

FileNameO = PathO + "EQ" + DD + MMO + YY + ".CSV"

If Dir(FileNameO) = "" Then
MsgBox "File Doesn't Exist (" + FileNameO + ")"
Exit Sub
End If

SheetName = UCase(SheetName)

Open FileNameO For Input As #1
While Not EOF(1)
Input #1, A1$, A2$, A3$, A4$, A5$, A6$, A7$, A8$, A9$, A10$, A11$, A12$, A13$, A14$
If A2 = SheetName Then
Cells(ActiveCell.Row, 2) = A5$
Cells(ActiveCell.Row, 3) = A6$
Cells(ActiveCell.Row, 4) = A7$
Cells(ActiveCell.Row, 5) = A8$
Cells(ActiveCell.Row, 6) = A12$
Close #1
Exit Sub
End If
Wend
Close #1

End Sub

[CatDaddy]

Application.ScreenUpdating = False
will speed up your program

Dim wb As Workbook
For each wb in Application.Workbooks
'do updating here
Next
will cycle through all open workbooks

[Shums]

Thanks Cat Daddy,

Still I cant get updates in all worksheet in a workbook, it updates only in current sheet.

I have changed VBA as such:

Sub Updates()

Dim wb As Workbook
For Each wb In Application.Workbooks
'do updating here
Next
Dim n As Long, k As Long
Application.ScreenUpdating = False
Range(ActiveCell, ActiveCell.Offset(Val(1) - 1, 0)).EntireRow.Insert

k = ActiveCell.Offset(-1, 0).Row
n = Cells(k, 83).End(xlToLeft).Column
Range(Cells(k, 83), Cells(k + Val(1), n)).FillDown

With ActiveCell
.Value = Format(Date, "dd-mmm-yy")
.Offset(0, 1).Value = "MH"
End With

Dim SheetName As String
Dim ActiveDate As String

PathO = "C:\Bhav Copy\"

SheetName = ActiveSheet.Name

ActiveDate = Cells(ActiveCell.Row, 1)
DD = Mid(ActiveDate, 1, 2)
MM = Mid(ActiveDate, 4, 3)
YY = Mid(ActiveDate, 8, 2)
If MM = "Jan" Then MMO = "01"
If MM = "Feb" Then MMO = "02"
If MM = "Mar" Then MMO = "03"
If MM = "Apr" Then MMO = "04"
If MM = "May" Then MMO = "05"
If MM = "Jun" Then MMO = "06"
If MM = "Jul" Then MMO = "07"
If MM = "Aug" Then MMO = "08"
If MM = "Sep" Then MMO = "09"
If MM = "Oct" Then MMO = "10"
If MM = "Nov" Then MMO = "11"
If MM = "Dec" Then MMO = "12"

FileNameO = PathO + "EQ" + DD + MMO + YY + ".CSV"

If Dir(FileNameO) = "" Then
MsgBox "File Doesn't Exist (" + FileNameO + ")"
Exit Sub
End If

SheetName = UCase(SheetName)

Open FileNameO For Input As #1
While Not EOF(1)
Input #1, A1$, A2$, A3$, A4$, A5$, A6$, A7$, A8$, A9$, A10$, A11$, A12$, A13$, A14$
If A2 = SheetName Then
Cells(ActiveCell.Row, 2) = A5$
Cells(ActiveCell.Row, 3) = A6$
Cells(ActiveCell.Row, 4) = A7$
Cells(ActiveCell.Row, 5) = A8$
Cells(ActiveCell.Row, 6) = A12$
Close #1
Exit Sub
End If
Wend
Close #1

End Sub

[Aussiebear]

Dim wb As Workbook
For each wb in Application.Workbooks
'do updating here
Next will cycle through all open workbooks

Try this instead

Dim sh As Worksheet
For each sh in Workbook
'do updateing here
Next

[Shums]

Thanks Aussie Bear,

Its shows error 424 and dubug, is it possible for you to add your code with mine.

[Bob Phillips]

You need to have all of your code within the two loops



For Each wb In Application.Workbooks

For Each ws in wb

'your worksheet code in here
' always referring to cells via the ws object
Next ws
Next wb


and remove all references to Activecell (this only refers to selected sheets, which you don't want) referring instead actual, explicit, cells.

[Shums]

Thanks XLD,

Could you rectify whole VBA code?

Still I am getting error 13 and debug.

[Bob Phillips]

I would struggle, because you use activecell, and I have no idea what I should change this to.

Show us your code that shows that error.

[Shums]

Hi All,

As I mentioned earlier; Everyday I am downloading data date wise in csv format, I already have VBA Code which insert row at the last row of current sheet, insert today's day, lookup sheet name and extract its data of only five columns from raw data(csv file) and lastly fill down the formulated upper row in current row. This VBA works fine with current sheet and I need to switch every sheet for updating. Now I need help in modifying my vba to update every sheet in workbook with just one command.

[Bob Phillips]

And that explains activecell in what way?

[Shums]

Hi XLD,

Active Cell is for updating current sheet, and I want to change it for updating whole workbook as per my requirement, not just current sheet.

[Bob Phillips]

We are getting nowhere, hopefully someone else will understand and be able to help you. Sorry.

[Shums]

Hi All,

Is there anyone who can help :help :help :help, please...................

Thanks in Advance.

[Kenneth Hobs]

First off, always use as the first line of your code:
Option Explicit

Since you have an extensive request for help, there are questions that need to be answered before detailed help can be given. For instance, it was asked what is your activecell. Is it Sheet1!A1, Sheet1!BF51. etc.? You insert a row at the activecell but what row is the activecell in? If you want row 1, that needs to be used, not the activecell.

If you need to open 25 workbooks and run the code on 20 worksheets then it will take some time to run. There are some things that can help speed it up more than what you have now but that is trivial. Once you get the code to run, there are some changes in your code that I would suggest.

What is the folder and filenames of the workbooks to open? What workbook will contain this macro code? What are the sheet names to run your code on? Is it all worksheets or will some be skipped?

I did not make too many changes here so as not to confuse you. Note that I added the loop to iterate the current workbook's worksheets collection. I used Select to set the worksheet to the current worksheet. There are better ways to do that as Select is seldom needed.
Sub Test_Updates()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Select
Updates
Next ws
End Sub

Sub Updates()
Dim n As Long, k As Long
Application.ScreenUpdating = False


ActiveCell.EntireRow.Insert

k = ActiveCell.Offset(-1, 0).Row
n = Cells(k, 83).End(xlToLeft).Column
Range(Cells(k, 83), Cells(k + Val(1), n)).FillDown

With ActiveCell
.Value = Format(Date, "dd-mmm-yy")
.Offset(0, 1).Value = "MH"
End With

Dim SheetName As String
Dim ActiveDate As String

PathO = "C:\Bhav Copy\"

SheetName = ActiveSheet.Name

ActiveDate = Cells(ActiveCell.Row, 1)
DD = Mid(ActiveDate, 1, 2)
MM = Mid(ActiveDate, 4, 3)
YY = Mid(ActiveDate, 8, 2)
If MM = "Jan" Then MMO = "01"
If MM = "Feb" Then MMO = "02"
If MM = "Mar" Then MMO = "03"
If MM = "Apr" Then MMO = "04"
If MM = "May" Then MMO = "05"
If MM = "Jun" Then MMO = "06"
If MM = "Jul" Then MMO = "07"
If MM = "Aug" Then MMO = "08"
If MM = "Sep" Then MMO = "09"
If MM = "Oct" Then MMO = "10"
If MM = "Nov" Then MMO = "11"
If MM = "Dec" Then MMO = "12"

FileNameO = PathO + "EQ" + DD + MMO + YY + ".CSV"

If Dir(FileNameO) = "" Then
MsgBox "File Doesn't Exist (" + FileNameO + ")"
Exit Sub
End If

SheetName = UCase(SheetName)

Open FileNameO For Input As #1
While Not EOF(1)
Input #1, A1$, A2$, A3$, A4$, A5$, A6$, A7$, A8$, A9$, A10$, A11$, A12$, A13$, A14$
If A2 = SheetName Then
Cells(ActiveCell.Row, 2) = A5$
Cells(ActiveCell.Row, 3) = A6$
Cells(ActiveCell.Row, 4) = A7$
Cells(ActiveCell.Row, 5) = A8$
Cells(ActiveCell.Row, 6) = A12$
Close #1
Exit Sub
End If
Wend
Close #1
End Sub

[Shums]

Thanks a lot Mr. Kenneth,

Firstly apologize for not mentioning the purpose of having this VBA code.

I am a day trader in stock market, I have compiled many indicators into an excel sheet, which helps me in selecting a stock for trading next day. I am checking 350 stocks everyday for which:

1. I have created different sheets for each stocks. for instance; "Microsoft Corp", Coca-Cola Company, Intel Corp, etc etc and so on.

2. I have created a folder name "BhavCopy", in which I download raw data everyday, which comes in .csv format. example; for today file name would be "EQ260711", for tomorrow "EQ270711" and so on.

3. I opened any of my workbook to be updated, I run this VBA on Active cell. Active cell; is the cell in last row in column A in every sheet.

4. This VBA firstly insert row in the last row of the sheet, insert today's date, extracts Open, High, Low, Close and Volume for the sheet name "Microsoft Corp" from "EQ260711" and lastly fill down the upper row which has numerous formulas in current row till the last column of the sheet.

Mr. Kenneth your code works perfectly fine, now for my knowledge could you please tell me why we need two Subs "Test_Updates" & again mine "Updates", I am sure after getting detailed intention, you can minimize this long code.

Thanks again.

[CatDaddy]

that code is not that long...

[Bob Phillips]

If it were I, there would be at least 3 procedures. I would put the code to workout the month number in a separate function at the very least..

[Kenneth Hobs]

I hope that your problem is now solved. Your last response made it much more clear to me.

XLD and Aussiebear used the same concept as I did only they iterated both the workbooks and what they thought was the worksheets collection. They just forgot to add the .worksheets part to the workbook object.

Like xld, I would also use multiple Subs. It makes it easier to see what is going on for one thing. The more Modular, within reason, the better.

Here is a tweak of your code. Note the alternative month number method. A better tweak would be to add a worksheet object to your routine and send the worksheet object in the call to your routine. I would also fix the activesheet deal and do away with Select.

cheers

Option Explicit
'http://vbaexpress.com/kb/getarticle.php?kb_id=1035
Public glb_origCalculationMode As Integer

Sub Test_Updates()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Select
Updates
Next ws
End Sub

Sub Updates()
Dim n As Integer, k As Long
Dim SheetName As String
Dim ActiveDate As String
Dim PathO As String, DD As String, MM As String, YY As String, MMO As String
Dim FileNameO
Dim A1 As String, A2 As String, A3 As String, A4 As String, A5 As String, A6 As String
Dim A7 As String, A8 As String, A9 As String, A10 As String, A11 As String, A12 As String
Dim A13 As String, A14 As String

On Error GoTo EndNow

ActiveCell.EntireRow.Insert

k = ActiveCell.Offset(-1, 0).Row
n = Cells(k, 83).End(xlToLeft).Column
Range(Cells(k, 83), Cells(k + Val(1), n)).FillDown

With ActiveCell
.Value = Format(Date, "dd-mmm-yy")
.Offset(0, 1).Value = "MH"
End With

PathO = "C:\Bhav Copy\"
SheetName = ActiveSheet.Name

ActiveDate = Cells(ActiveCell.Row, 1)
DD = Mid(ActiveDate, 1, 2)
MM = Mid(ActiveDate, 4, 3)
YY = Mid(ActiveDate, 8, 2)
MMO = Format(CDate(ActiveDate), "mm")

FileNameO = PathO & "EQ" & DD & MMO & YY & ".CSV"

If Dir(FileNameO) = "" Then
MsgBox "File Doesn't Exist (" & FileNameO & ")"
EndNow
End If

SheetName = UCase(SheetName)

Open FileNameO For Input As #1
While Not EOF(1)
Input #1, A1$, A2$, A3$, A4$, A5$, A6$, A7$, A8$, A9$, A10$, A11$, A12$, A13$, A14$
If A2 = SheetName Then
Cells(ActiveCell.Row, 2) = A5$
Cells(ActiveCell.Row, 3) = A6$
Cells(ActiveCell.Row, 4) = A7$
Cells(ActiveCell.Row, 5) = A8$
Cells(ActiveCell.Row, 6) = A12$
Close #1
Exit Sub
End If
Wend
Close #1

EndNow:
SpeedOff
End Sub

Sub SpeedOn(Optional StatusBarMsg As String = "Running macro...")
glb_origCalculationMode = Application.Calculation
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Cursor = xlWait
.StatusBar = StatusBarMsg
.EnableCancelKey = xlErrorHandler
End With
End Sub

Sub SpeedOff()
With Application
.Calculation = glb_origCalculationMode
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.CalculateBeforeSave = True
.Cursor = xlDefault
.StatusBar = False
.EnableCancelKey = xlInterrupt
End With
End Sub

[Shums]

Thank you all,

Mr. Kenneth,

There was an error on "EndNow" after MsgBox, so I changed it to "End Sub" and it work perfectly.

Sorry to bother you more, I would really appreciate if you could change Active Cell, as it is inserting a row wherever cursor is, can't we automate itself to go to the last row of the sheet and run this code?

Thanks Again.

[Kenneth Hobs]

Rather than EndNow after the MsgBox, I should have put:
GoTo EndNow Using End Sub skips the routine that resets some things.

As we said, activecell is not the route to pursue. When you say last row, I don't know what that means. Last row with data based on a column of data or any column with data or the literal last row 104576?

Most go to the end of the data in column A or the row that follows that. The commented line goes to the next row after last row with data in column A. e.g.

Sub Test_Updates()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Select
Range("A" & Rows.Count).End(xlUp).Select 'last row in column A with data
'Range("A" & Rows.Count).End (xlUp).offset(1).select 'after last row in column A with data
Updates
Next ws
End Sub

[Shums]

Thanks indeed ... it was great help. it has made my life easier, no words to describe your kind gesture

[Shums]

Hi All,

I was very happy with the below code, everything is working perfectly:
Sub Run_Updates()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Select
Range("A1").End(xlDown).Offset(1).Select
ActiveWindow.SmallScroll Down:=1
Updates
Next ws
End Sub

Sub Updates()

Dim n As Long, k As Long

Range(ActiveCell, ActiveCell.Offset(Val(1) - 1, 0)).EntireRow.Insert

k = ActiveCell.Offset(-1, 0).Row
n = Cells(k, 84).End(xlToLeft).Column
Range(Cells(k, 84), Cells(k + Val(1), n)).FillDown

With ActiveCell
.Value = Format(Date, "dd-mmm-yy")
.Offset(0, 1).Value = "MH"
End With

Dim SheetName As String
Dim ActiveDate As String

PathO = "C:\Bhav Copy\"

SheetName = ActiveSheet.Name

ActiveDate = Cells(ActiveCell.Row, 1)
DD = Mid(ActiveDate, 1, 2)
MM = Mid(ActiveDate, 4, 3)
YY = Mid(ActiveDate, 8, 2)
MMO = Format(CDate(Range("A" & ActiveCell.Row)), "mm")

FileNameO = PathO + "EQ" + DD + MMO + YY + ".CSV"

If Dir(FileNameO) = "" Then
MsgBox "File Doesn't Exist (" + FileNameO + ")"
Exit Sub
End If

SheetName = UCase(SheetName)

Open FileNameO For Input As #1
While Not EOF(1)
Input #1, A1$, A2$, A3$, A4$, A5$, A6$, A7$, A8$, A9$, A10$, A11$, A12$, A13$, A14$
If A2 = SheetName Then
Cells(ActiveCell.Row, 2) = A5$
Cells(ActiveCell.Row, 3) = A6$
Cells(ActiveCell.Row, 4) = A7$
Cells(ActiveCell.Row, 5) = A8$
Cells(ActiveCell.Row, 6) = A12$
Close #1
Exit Sub
End If
Wend
Close #1

EndNow:
SpeedOff
End Sub

Sub SpeedOn(Optional StatusBarMsg As String = "Running macro...")
glb_origCalculationMode = Application.Calculation
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Cursor = xlWait
.StatusBar = StatusBarMsg
.EnableCancelKey = xlErrorHandler
End With
End Sub

Sub SpeedOff()
With Application
.Calculation = glb_origCalculationMode
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.CalculateBeforeSave = True
.Cursor = xlDefault
.StatusBar = False
.EnableCancelKey = xlInterrupt
End With
End Sub




Now I would request you all to help in modifying above code to update all the workbooks with numerous sheet without opening every workbook.

[Shums]

Hi All,

I would like to modify above code by creating new sheet, which will run above code in all the workbooks in that specific folder.

Please help.

Any help would be highly appreciated.

[Shums]

Hi All,

Kinda reminder, Please help me in getting code which can run above code in all the files in specific folder (C:\Documents and Settings\ShumsPC\Desktop\BSE\Desktop\Updation).

[Kenneth Hobs]

This is just a modification of what I showed you in: http://www.vbaexpress.com/forum/showthread.php?p=257028

In the Updates() Sub, you may need to modify it to create unique text file names.

Sub DoUpdates()
Dim pFolder As String, fileList As Variant, f As Variant
Dim ws As Worksheet

On Error GoTo TheEnd
SpeedOn

'Set the parent folder of slave workbooks to process.
pFolder = ThisWorkbook.Path & "\" '<-------- Change as needed.

' Open each workbook except thisworkbook and get the data.
fileList = GetFileList(pFolder & "*.xl*")
For Each f In fileList
If ThisWorkbook.Name = f Then GoTo Nextf

'Do your thing from here to Nextf.
Set slaveWB = Workbooks.Open(pFolder & f)

'Add the data from slave to master.
For Each ws In slaveWB.Worksheets
ws.Activate
Updates
Next ws
slaveWB.Close True
Nextf:
Next f

TheEnd:
SpeedOff
End Sub

[Shums]

Hi Mr. Ken,

Sorry to bother you so much, I am almost at at my reach, but something is missing. It dubug on PathO, saying variant not defined.

See below modified code:
Option Explicit

Public glb_origCalculationMode As Integer

Sub SpeedOn(Optional StatusBarMsg As String = "Running macro...")
glb_origCalculationMode = Application.Calculation
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Cursor = xlWait
.StatusBar = StatusBarMsg
.EnableCancelKey = xlErrorHandler
End With
End Sub

Sub SpeedOff()
With Application
.Calculation = glb_origCalculationMode
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.CalculateBeforeSave = True
.Cursor = xlDefault
.StatusBar = False
.EnableCancelKey = xlInterrupt
End With
End Sub
Sub DoUpdates()
Dim pFolder As String, fileList As Variant, f As Variant
Dim ws As Worksheet
Dim slaveWB As Workbook

On Error GoTo TheEnd
SpeedOn

'Set the parent folder of slave workbooks to process.
pFolder = "C:\Test" & "\" '<-------- Change as needed.

' Open each workbook except thisworkbook and get the data.
fileList = GetFileList(pFolder & "*.xl*")
For Each f In fileList
If ThisWorkbook.Name = f Then GoTo Nextf

'Do your thing from here to Nextf.
Set slaveWB = Workbooks.Open(pFolder & f)

'Add the data from slave to master.
For Each ws In slaveWB.Worksheets
ws.Activate
Run_Updates
Next ws
slaveWB.Close True
Nextf:
Next f

TheEnd:
SpeedOff
End Sub
Sub Run_Updates()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Select
Range("A1").End(xlDown).Offset(1).Select
ActiveWindow.SmallScroll Down:=1
Updates
Next ws
End Sub
Sub Updates()

Dim n As Long, k As Long

Range(ActiveCell, ActiveCell.Offset(Val(1) - 1, 0)).EntireRow.Insert

k = ActiveCell.Offset(-1, 0).Row
n = Cells(k, 84).End(xlToLeft).Column
Range(Cells(k, 84), Cells(k + Val(1), n)).FillDown

With ActiveCell
.Value = Format(Date, "dd-mmm-yy")
.Offset(0, 1).Value = "MH"
End With

Dim SheetName As String
Dim ActiveDate As String

PathO = "C:\Bhav Copy"

SheetName = ActiveSheet.Name

ActiveDate = Cells(ActiveCell.Row, 1)
DD = Mid(ActiveDate, 1, 2)
MM = Mid(ActiveDate, 4, 3)
YY = Mid(ActiveDate, 8, 2)
MMO = Format(CDate(Range("A" & ActiveCell.Row)), "mm")

FileNameO = PathO + "EQ" + DD + MMO + YY + ".CSV"

If Dir(FileNameO) = "" Then
MsgBox "File Doesn't Exist (" + FileNameO + ")"
Exit Sub
End If

SheetName = UCase(SheetName)

Open FileNameO For Input As #1
While Not EOF(1)
Input #1, A1$, A2$, A3$, A4$, A5$, A6$, A7$, A8$, A9$, A10$, A11$, A12$, A13$, A14$
If A2 = SheetName Then
Cells(ActiveCell.Row, 2) = A5$
Cells(ActiveCell.Row, 3) = A6$
Cells(ActiveCell.Row, 4) = A7$
Cells(ActiveCell.Row, 5) = A8$
Cells(ActiveCell.Row, 6) = A12$
Close #1
Exit Sub
End If
Wend
Close #1
EndNow:
SpeedOff
End Sub
Function GetFileList(FileSpec As String) As Variant
' Returns an array of filenames that match FileSpec
' If no matching files are found, it returns False

Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String

On Error GoTo NoFilesFound

FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then GoTo NoFilesFound

' Loop until no more matching files are found
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop
GetFileList = FileArray
Exit Function

' Error handler
NoFilesFound:
GetFileList = False
End Function

[Shums]

Sorry "Compile Error: Variable not defined"

[Kenneth Hobs]

Look at the Dim PathO as String in post 18.

[Shums]

Sir,

When I remove SpeedOff/ON, then its working fine with below code, but it extract data 11times in each file.
Sub DoUpdates()
Dim pFolder As String, fileList As Variant, f As Variant
Dim ws As Worksheet
Dim slaveWB As Workbook

On Error GoTo TheEnd


'Set the parent folder of slave workbooks to process.
pFolder = "C:\Test" & "\" '<-------- Change as needed.

' Open each workbook except thisworkbook and get the data.
fileList = GetFileList(pFolder & "*.xl*")
For Each f In fileList
If ThisWorkbook.Name = f Then GoTo Nextf

'Do your thing from here to Nextf.
Set slaveWB = Workbooks.Open(pFolder & f)

'Add the data from slave to master.
For Each ws In slaveWB.Worksheets
ws.Activate
Run_Updates
Next ws
slaveWB.Close True
Nextf:
Next f

TheEnd:

End Sub
Sub Run_Updates()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Select
Range("A1").End(xlDown).Offset(1).Select
ActiveWindow.SmallScroll Down:=1
Updates
Next ws
End Sub
Sub Updates()

Dim n As Long, k As Long

Range(ActiveCell, ActiveCell.Offset(Val(1) - 1, 0)).EntireRow.Insert

k = ActiveCell.Offset(-1, 0).Row
n = Cells(k, 84).End(xlToLeft).Column
Range(Cells(k, 84), Cells(k + Val(1), n)).FillDown

With ActiveCell
.Value = Format(Date, "dd-mmm-yy")
.Offset(0, 1).Value = "MH"
End With

Dim SheetName As String
Dim ActiveDate As String

PathO = "C:\Bhav Copy\"

SheetName = ActiveSheet.Name

ActiveDate = Cells(ActiveCell.Row, 1)
DD = Mid(ActiveDate, 1, 2)
MM = Mid(ActiveDate, 4, 3)
YY = Mid(ActiveDate, 8, 2)
MMO = Format(CDate(Range("A" & ActiveCell.Row)), "mm")

FileNameO = PathO + "EQ" + DD + MMO + YY + ".CSV"

If Dir(FileNameO) = "" Then
MsgBox "File Doesn't Exist (" + FileNameO + ")"
Exit Sub
End If

SheetName = UCase(SheetName)

Open FileNameO For Input As #1
While Not EOF(1)
Input #1, A1$, A2$, A3$, A4$, A5$, A6$, A7$, A8$, A9$, A10$, A11$, A12$, A13$, A14$
If A2 = SheetName Then
Cells(ActiveCell.Row, 2) = A5$
Cells(ActiveCell.Row, 3) = A6$
Cells(ActiveCell.Row, 4) = A7$
Cells(ActiveCell.Row, 5) = A8$
Cells(ActiveCell.Row, 6) = A12$
Close #1
Exit Sub
End If
Wend
Close #1
EndNow:

End Sub
Function GetFileList(FileSpec As String) As Variant
' Returns an array of filenames that match FileSpec
' If no matching files are found, it returns False

Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String

On Error GoTo NoFilesFound

FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then GoTo NoFilesFound

' Loop until no more matching files are found
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop
GetFileList = FileArray
Exit Function

' Error handler
NoFilesFound:
GetFileList = False
End Function

[Shums]

Actually it counts the number of sheets and extract data that much times.
In BSE-Auto, it did 11 times and in BSE-CD it did 8 times.

[Kenneth Hobs]

So? I don't know what "it" is.

I don't see a need for Run_Updates.

[Shums]

Mr. Ken,

I don't have words to express my gratitude, things are working absolutely perfect as per below code.

It just taking very long time to update each file as I haven't added your SpeedOn/SpeedOff explicit.

Sub FolderUpdates()
Dim pFolder As String, fileList As Variant, f As Variant
Dim ws As Worksheet
Dim slaveWB As Workbook

On Error GoTo TheEnd

'Set the parent folder of slave workbooks to process.
pFolder = "C:\Test" & "\" '<-------- Change as needed.

' Open each workbook except thisworkbook and get the data.
fileList = GetFileList(pFolder & "*.xl*")
For Each f In fileList
If ThisWorkbook.Name = f Then GoTo Nextf

'Do your thing from here to Nextf.
Set slaveWB = Workbooks.Open(pFolder & f)
Application.ScreenUpdating = True

'Add the data from slave to master.
For Each ws In slaveWB.Worksheets
ws.Activate
Updates
Next ws
slaveWB.Close True

Nextf:
Next f
Application.ScreenUpdating = True
TheEnd:

End Sub
Sub Updates()

Dim n As Long, k As Long

Range("A1").End(xlDown).Offset(1).Select
ActiveWindow.SmallScroll Down:=1
Range(ActiveCell, ActiveCell.Offset(Val(1) - 1, 0)).EntireRow.Insert
k = ActiveCell.Offset(-1, 0).Row
n = Cells(k, 84).End(xlToLeft).Column
Range(Cells(k, 84), Cells(k + Val(1), n)).FillDown
With ActiveCell
.Value = Format(Date, "dd-mmm-yy")
.Offset(0, 1).Value = "MH"

Dim SheetName As String
Dim ActiveDate As String

PathO = "C:\Bhav Copy\"

SheetName = ActiveSheet.Name

ActiveDate = Cells(ActiveCell.Row, 1)
DD = Mid(ActiveDate, 1, 2)
MM = Mid(ActiveDate, 4, 3)
YY = Mid(ActiveDate, 8, 2)
MMO = Format(CDate(Range("A" & ActiveCell.Row)), "mm")

FileNameO = PathO + "EQ" + DD + MMO + YY + ".CSV"

If Dir(FileNameO) = "" Then
MsgBox "File Doesn't Exist (" + FileNameO + ")"
Exit Sub
End If

SheetName = UCase(SheetName)

Open FileNameO For Input As #1
While Not EOF(1)
Input #1, A1$, A2$, A3$, A4$, A5$, A6$, A7$, A8$, A9$, A10$, A11$, A12$, A13$, A14$
If A2 = SheetName Then
Cells(ActiveCell.Row, 2) = A5$
Cells(ActiveCell.Row, 3) = A6$
Cells(ActiveCell.Row, 4) = A7$
Cells(ActiveCell.Row, 5) = A8$
Cells(ActiveCell.Row, 6) = A12$
Close #1
Exit Sub
End If
Wend
Close #1
End With
End Sub
Function GetFileList(FileSpec As String) As Variant
' Returns an array of filenames that match FileSpec
' If no matching files are found, it returns False

Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String

On Error GoTo NoFilesFound

FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then GoTo NoFilesFound

' Loop until no more matching files are found
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop
GetFileList = FileArray
Exit Function

' Error handler
NoFilesFound:
GetFileList = False
End Function


I can't stop thanking you. You helped me thrice and my life so easier.

Wish You A Merry Christmas & Prosperous New Year.

[Shums]

Thank You All for your effort and time.