Please help in vba code

NIPUL JARIWALA

New Member
Joined
Apr 22, 2016
Messages
46
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
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

ranman256

Well-known Member
Joined
Jun 17, 2014
Messages
1,974
this does seem wrong, but I cant tell what youre trying to do.
 

NIPUL JARIWALA

New Member
Joined
Apr 22, 2016
Messages
46
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
Joined
Oct 9, 2017
Messages
6
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>
 

Gindo70

New Member
Joined
Oct 9, 2017
Messages
6
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/
 

Watch MrExcel Video

Forum statistics

Threads
1,129,358
Messages
5,635,800
Members
416,883
Latest member
jwchase

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Top