View Full Version : Handling large amount of data in one excel sheet

03-13-2012, 06:42 PM
I have a large amount of data (168035 * 374) which i want to process. My task is to search some specific record on user input.
e.g., If user is asked to input some number. Then this number will be matched with all A1 (168035 rows)and if the match occurs in multiple places, it should fetch those records (rows) and save it to another worksheet.
I have some code, which is not efficient. when i run the query, excel becomes non responsive (halts). Please give me some suggestion
NOTE: i am using excel-2007
Here is my code:

Sub copying()
Dim i As long, j As long
Dim strsearch As String, lastline As long, tocopy As long
strsearch = CStr(InputBox("Please Enter the video ID: "))
lastline = Range("A1048576").End(xlUp).Row
j = 1
For i = 1 To lastline
For Each c In Range("A" & i)
If InStr(c.Text, strsearch) Then
tocopy = 1
End If
Next c
If tocopy = 1 Then
Rows(i).Copy Destination:=Sheets(2).Rows(j)
j = j + 1
End If
tocopy = 0
Next i
MsgBox "All matching data has been copied."
End Sub

Jan Karel Pieterse
03-13-2012, 10:19 PM
I'd manually set up an autofilter on that column while recording a macro...

03-14-2012, 01:18 AM
why not access dbase?

03-14-2012, 03:11 AM
Hi kkj,

I agree with mancubus that using Access or other database is going to be the best option, but if it needs to be done in Excel, Jan Karel Pieterse advice to use the autofilter is going to be far more efficient than looping.

Maybe something like this:

Option Explicit
Sub CopyFilteredResultsToAnotherSheet()
Dim strsearch As String, Calc As Integer
Dim Lastrow As Long, LastCol As Integer
Dim rng As Range, SourceSheet As Worksheet, DestinationSheet As Worksheet

Set SourceSheet = Worksheets("Sheet1") 'change to suit
Set DestinationSheet = Worksheets("Sheet2") 'change to suit
Application.ScreenUpdating = False
Application.EnableEvents = False
Calc = Application.Calculation
Application.Calculation = xlCalculationManual


With SourceSheet
Lastrow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastCol = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

Set rng = .Range(.Cells(1, 1), .Cells(Lastrow, LastCol))

End With

If Not rng Is Nothing Then

strsearch = CStr(InputBox("Please Enter the video ID: "))

If Trim(strsearch) = "" Then GoTo Finish

rng.AutoFilter Field:=1, Criteria1:=strsearch

rng.SpecialCells(xlCellTypeVisible).Copy DestinationSheet.Cells(1, 1)

End If

Application.ScreenUpdating = True

If DestinationSheet.UsedRange.Rows.Count > 1 Then
MsgBox DestinationSheet.UsedRange.Rows.Count - 1 & " match's found"
MsgBox "No matches"
End If

With SourceSheet
If .AutoFilterMode = True Then
.AutoFilterMode = False
.EnableAutoFilter = True
End If
End With
Application.EnableEvents = True
Application.Calculation = Calc

End Sub

Zack Barresse
03-15-2012, 06:49 AM
Cross-post: http://www.mrexcel.com/forum/showthread.php?t=621054.

Please DO NOT cross post. It's very frustrating for people offering help when they see their efforts for nothing when it's been answered on another forum.

03-15-2012, 07:01 AM
Set a referenence to Microsoft ActiveX Data Objects in the VBE then

With xlCon
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & FullFileName & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes;"""
End With

03-15-2012, 07:07 AM
Sorry sent before complete

Dim xlCon as New ADODB.Connectiion
Dim RS as New ADODB.Recordset

RS.Open "SELECT * FROM [Sheet1$A1:EZ65000]", _
conXL, adOpenKeyset, adLockReadOnly

This will give you a recordset where all ADO facilities are available, in particular:
RS.Filter = "Col1=" & Cstr(NumberToFind)

Col1 should be a field name at the top of Column 1 - this will result in a recordset of zero (no matches) to the number of matches found which can then be processed at the time. It is very quick.

03-15-2012, 07:10 AM
Sorry zack,
I already apologized on that forum. I am a new user and i overlooked that rule mistakenly. Now i will not do that again.
Thanks for guiding me.

03-16-2012, 04:56 PM