Please help in vba code

[NIPUL JARIWALA]

I have written a VBA code.
But it takes TOO MUCH time to complete.
Is there any other code to solve the time problem
Please help me 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("AD1048576").End(xlUp).Offset(1, 0) = Sheet1.Cells(L1, 4)
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

Please help me

 

[ranman256]

this does seem wrong, but I cant tell what youre trying to do.

 

[NIPUL JARIWALA]

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]

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>

 

[NIPUL JARIWALA]

It's not working

 

[Gindo70]

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

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