#### NIPUL JARIWALA

##### New Member
I have written a VBA code.
But it takes TOO MUCH time to complete.
Is there any other code to solve the time problem
Code:

Sub FIND()
Dim B, C, D, E, F, G, H, I, J, K, L As Integer
B = Sheet3.Range("B1048576").End(xlUp).Row
C = Sheet3.Range("C1048576").End(xlUp).Row
D = Sheet3.Range("D1048576").End(xlUp).Row
E = Sheet3.Range("E1048576").End(xlUp).Row
F = Sheet3.Range("F1048576").End(xlUp).Row
G = Sheet3.Range("G1048576").End(xlUp).Row
H = Sheet3.Range("H1048576").End(xlUp).Row
I = Sheet3.Range("I1048576").End(xlUp).Row
J = Sheet3.Range("J1048576").End(xlUp).Row
K = Sheet3.Range("K1048576").End(xlUp).Row
L = Sheet1.Range("A1048576").End(xlUp).Row
For B1 = 2 To B
For C1 = 2 To C
For D1 = 2 To D
For E1 = 2 To E
For F1 = 2 To F
For G1 = 2 To G
For H1 = 2 To H
For I1 = 2 To I
For J1 = 2 To J
For K1 = 2 To K
For L1 = 4 To L
If Sheet3.Cells(B1, 2) = Sheet1.Cells(L1, 2) Then
If Sheet3.Cells(C1, 3) = Sheet1.Cells(L1, 3) Then
If Sheet3.Cells(D1, 4) = Sheet1.Cells(L1, 4) Then
If Sheet3.Cells(E1, 5) = Sheet1.Cells(L1, 12) Then
If Sheet3.Cells(F1, 6) = Sheet1.Cells(L1, 6) Then
If Sheet3.Cells(G1, 7) = Sheet1.Cells(L1, 7) Then
If Sheet3.Cells(H1, 8) = Sheet1.Cells(L1, 8) Then
If Sheet3.Cells(I1, 9) = Sheet1.Cells(L1, 9) Then
If Sheet3.Cells(J1, 10) = Sheet1.Cells(L1, 10) Then
If Sheet3.Cells(K1, 11) = Sheet1.Cells(L1, 11) Then
If Application.WorksheetFunction.CountIf(Sheet3.Range("AA2:AA1048576"), Sheet1.Cells(L1, 1)) = 0 Then
Sheet3.Range("AA1048576").End(xlUp).Offset(1, 0) = Sheet1.Cells(L1, 1)
Sheet3.Range("AB1048576").End(xlUp).Offset(1, 0) = Sheet1.Cells(L1, 2)
Sheet3.Range("AC1048576").End(xlUp).Offset(1, 0) = Sheet1.Cells(L1, 3)
Sheet3.Range("AE1048576").End(xlUp).Offset(1, 0) = Sheet1.Cells(L1, 5)
Sheet3.Range("AF1048576").End(xlUp).Offset(1, 0) = Sheet1.Cells(L1, 6)
Sheet3.Range("AG1048576").End(xlUp).Offset(1, 0) = Sheet1.Cells(L1, 7)
Sheet3.Range("AH1048576").End(xlUp).Offset(1, 0) = Sheet1.Cells(L1, 8)
Sheet3.Range("AI1048576").End(xlUp).Offset(1, 0) = Sheet1.Cells(L1, 9)
Sheet3.Range("AJ1048576").End(xlUp).Offset(1, 0) = Sheet1.Cells(L1, 10)
Sheet3.Range("AK1048576").End(xlUp).Offset(1, 0) = Sheet1.Cells(L1, 11)
Sheet3.Range("AL1048576").End(xlUp).Offset(1, 0) = Sheet1.Cells(L1, 12)
Sheet3.Range("AM1048576").End(xlUp).Offset(1, 0) = Sheet1.Cells(L1, 13)
Sheet3.Range("AN1048576").End(xlUp).Offset(1, 0) = Sheet1.Cells(L1, 14)
Sheet3.Range("AO1048576").End(xlUp).Offset(1, 0) = Sheet1.Cells(L1, 15)
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
Next L1
Next K1
Next J1
Next I1
Next H1
Next G1
Next F1
Next E1
Next D1
Next C1
Next B1
End Sub

### Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

#### ranman256

##### Well-known Member
this does seem wrong, but I cant tell what youre trying to do.

#### NIPUL JARIWALA

##### New Member
My database is in sheet1 and range is A4 to AO10000
My criteria is in sheet3 and range is B2 to K10000
And i want to search in my database as per criteria in sheet3 and it's ranges are AA3 to AA50000

If you wand i will send you my file with some of my data
thank you

#### Gindo70

##### New Member
Try disabling the Screenupdate. It should boost the speed.

<code class="lang-vb hljs vbnet expanded">Application.ScreenUpdating = False
Code insert
<code class="lang-vb hljs vbnet expanded">Application.ScreenUpdating = True</code></code>

It's not working

#### Gindo70

##### New Member
Do you have Formulas/Charts/Pivottabels ect. in your Workbook?
In your code you could change:
Sheet3.Range("AA1048576").End(xlUp).Offset(1, 0) = Sheet1.Cells(L1, 1)
Sheet3.Range("AB1048576").End(xlUp).Offset(1, 0) = Sheet1.Cells(L1, 2)
...
To:
With Sheet3
.Range("AA1048576").End(xlUp).Offset(1, 0) = Sheet1.Cells(L1, 1)
.Range("AB1048576").End(xlUp).Offset(1, 0) = Sheet1.Cells(L1, 2)
End With

http://datapigtechnologies.com/blog/index.php/ten-things-you-can-do-to-speed-up-your-excel-vba-code/

Replies
1
Views
138
Replies
3
Views
216
Replies
2
Views
308
Replies
0
Views
229
Replies
1
Views
165

1,171,049
Messages
5,873,471
Members
432,981
Latest member
DMcDaniel

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back