How to extract data form closed workbook matching more than one criteria without oping the workbook? - vba

Question

I need to extract data from one big Excel matching row and column criteria. I have big Excel with 100 or sheets and bigger than 120mb. I need to extract the data from that workbook to current workbook matching sheet name, column criteria and row criteria.
I have a code which can do that but the problem is if every time I open the workbook in the background and close it that takes too much time. So how can I it without opening it in the background? I have read about ADO connecting but I actually do not understand the code and also I don't understand about how can I do it with excel4macro.
I am including my code. I am new to coding so there will be lots of mistakes I guess. This is for my work purpose.
Sub WCDMA_Network_Planning_DumpData_Extract()
Dim ws As Worksheet
Dim wsname As String
Dim wsnamed As String
Dim finalrow As Integer
Dim finalcol As Integer
Dim paraname1() As Variant
Dim columnnumber As Integer
Dim filename As String
Dim cellnm1() As Variant
Dim rownumber As Integer
Dim firstrow As Integer
Dim firstcolumn As Integer
Dim value() As Variant
Dim add As String
Dim firstrow2 As Integer
Dim finalrow2 As Double
Dim firstcolumn2 As Integer
Dim ra As Range
Dim add2 As String
Dim add3 As String
Dim add4 As String
Dim add5 As String
Dim var As Integer
Dim add6 As String
Dim mypath As String
Dim ol As Integer
Dim firstcelladd As String
Dim firstcell As Range
Dim rl As Integer
Application.ScreenUpdating = False
''this is to get the activehseet name which i will match with the search workbook
filename = ActiveWorkbook.Name
wsname = ActiveSheet.Name
' this is to find "Cell Name" which is my column criteria
Set ra = Range("A1:F10").find(what:="Cell Name", lookat:=xlWhole)
add = ra.Address
add5 = Mid(add, 2, 1) & "1"
add2 = Mid(add, 2, 1) & "22000"
'first column and last row finding of current sheet where i want to extract data
firstcolumn = Range("A1:F10").find(what:="Cell Name", lookat:=xlWhole).Column
firstrow = Range("A1:F10").find(what:="Cell Name", lookat:=xlWhole).Row + 1
finalcolumn = Sheets(wsname).Range("GG2").End(xlToLeft).Column
finalrow = Sheets(wsname).Range(add2).End(xlUp).Row
'array diclaration where i will put my serch criteria and matched value
ReDim paraname1(1 To finalcolumn)
ReDim value(1 To 23000, 1 To finalcolumn)
ReDim cellnm1(1 To finalrow)
var = firstcolumn - 1
'this is for active sheet where i put my seche criteria for row and clumn value
For I = firstcolumn To finalcolumn
'column criteria for search
paraname1(I) = Cells(firstrow - 1, I).value
Next
'row criteria
For j = firstrow To finalrow
cellnm1(j) = Cells(j, firstcolumn).value
Next
''this is the workbook form where i want to get the value
Application.ScreenUpdating = False
mypath = "D:\Office Work\VBA Work\3G Radio Network Planning Data Template.xlsm"
Workbooks.Open filename:=mypath
Application.EnableEvents = False
''select the sheet form whcih i will get the data
Workbooks("3G Radio Network Planning Data Template").Activate
Sheets(wsname).Select
Sheets(wsname).AutoFilterMode = False
''first row and finalrow selection
finalrow2 = Sheets(wsname).Range("A1000000").End(xlUp).Row
firstrow2 = Range("a1: i100").find(what:="Cell Name", lookat:=xlWhole).Row
fistcolumn2 = Range("a1: i100").find(what:="Cell Name", lookat:=xlWhole).Column
''serchrange selection
add3 = Range("a1: i100").find(what:="Cell Name", lookat:=xlWhole).Address
add6 = Mid(add3, 2, 1) & "1"
add4 = Mid(add3, 2, 1) & finalrow2
For k = firstcolumn To finalcolumn
" macth the row criteria form my active sheet to the sheet i want to get the value form''
ol = 1
columnnumber = Application.Match(paraname1(k),Sheets(wsname).Range("2:2"), 0)
For l = firstrow To finalrow
'macth the column value form my first active sheet to the sheet form where i want to get the value from
Set firstcell = Range(add6, add4).find(what:=cellnm1(l), lookat:=xlWhole)
rownumber = Range(add6, add4).find(what:=cellnm1(l), lookat:=xlWhole).Row
firstcelladd = firstcell.Address
On Error GoTo msg
value(ol, k) = Cells(rownumber, columnnumber)
ol = ol + 1
Do
Set firstcell = Range(add6, add4).FindNext(firstcell)
rownumber = firstcell.Row
If firstcell.Address <> firstcelladd Then
value(ol, k) = Cells(rownumber, columnnumber)
ol = ol + 1
End If
Loop Until firstcell.Address = firstcelladd
Next
Next
ol = 1
'ActiveWorkbook.Close False
' select the previsus active workook aging where i wil paste the value
Workbooks(filename).Activate
Sheets(wsname).Select
Sheets(wsname).AutoFilterMode = False
For s = firstcolumn To finalcolumn
rl = firstrow
ol = 1
Do
Cells(rl, s) = value(ol, s)
rl = rl + 1
ol = ol + 1
Loop While value(ol, s) <> ""
Next
Erase cellnm1
Erase paraname1
Erase value
Exit Sub
msg: MsgBox (" Cell Name " & cellnm1(l) & " not found")
End Sub

Answer 1

I guess it is impossible. To access data with definite filters and so on, you'll need to open it, even through ADO. Anyway, you can speed-up the closing, as you don't need to save book, from which you are copying data. That's one part.
Other part, if you are copying it many times, you can organize extract/transform/load task just in to:
open source book
create target book file
filter source data
copy data to target book
save target book
Without closing source book repeat points 2-5 as much as needed. This is maximum you can get.
Other part is that XLSX itself is an ZIP archive, so it will take a plenty of time to decompress it anyway. You can also keep these files on SSD drive or attach virtual RAM disk maybe, this could save a bit more time also.