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