Solved: VBA for updating every worksheet in workbook.

[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:
[VBA]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


[/VBA]

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.

[VBA]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[/VBA]

[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:
[VBA]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

[/VBA]

[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.
[VBA]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
[/VBA]

[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.

[VBA]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
[/VBA]

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.