Data Compilation time reducing Using VBA

Data Compilation Time Reduction Using VBA

Most of the time data is gathered from various Sub-divisions, compiled by Divisions, then by Circle offices, Region offices, and finally by Mantralaya.

Google Sheets is a good option, but internet connectivity issues and large file sizes can sometimes create problems.

Since the format is generally kept the same, copy-paste seems like a simple solution — but as we all know, it often consumes a huge amount of time.

Here I have tried to automate this process using VBA.

Demo Video

Here is a short demonstration of how it works:

VBA Script

The following VBA code performs the automation shown in the video. It can be further modified as per your specific requirements.

Features of this script:

1. Opens all Excel files in a specified folder
2. Reads the required data from each file (currently Sheet 4, rows 1–50, columns 1–20)
3. Saves the data in memory (array)
4. Closes each file without saving changes
5. After processing all files, writes the collected data to the master workbook

Option Explicit Sub prepare_data() Dim i As Long, j As Long Dim n As Long Dim rows As Long, columns As Long Dim path As String Dim filename As String Dim Col(1 To 5000, 1 To 30) As Variant ' Adjust size if needed Dim sourceFileName(1 To 5000) As String Application.ScreenUpdating = False i = 0 ' Folder where source files are kept (create "Files" folder in same location as this workbook) path = ThisWorkbook.path & "\Files\" filename = Dir(path & "*.xls*") ' *.xls* catches both .xls & .xlsx Do While filename <> "" On Error Resume Next Workbooks.Open Filename:=path & filename, _ ReadOnly:=True, _ UpdateLinks:=0 If Err.Number <> 0 Then MsgBox "Could not open: " & filename Err.Clear GoTo NextFile End If ActiveWorkbook.UpdateLinks = False ' Read data from Sheet 4 (index 4), rows 1-50, columns 1-20 For rows = 1 To 50 i = i + 1 For columns = 1 To 20 Col(i, columns) = Sheets(4).Cells(rows, columns).Value Next columns Next rows sourceFileName(i) = filename Workbooks(filename).Close SaveChanges:=False NextFile: filename = Dir Loop ' Write all collected data to active sheet For n = 1 To i For columns = 1 To 20 Cells(n, columns).Value = Col(n, columns) Next columns Next n Application.ScreenUpdating = True MsgBox "Data compilation completed! " & vbCrLf & _ i & " rows collected from all files.", vbInformation End Sub

Note: Place all source Excel files in a sub-folder named "Files" in the same directory as this macro workbook.
You can adjust the sheet number, row/column ranges, and array sizes according to your actual data structure.