I need a Faster loop

Hal75

New Member
Joined
Dec 31, 2017
Messages
2
Dear All,

I am new to Excel VBA. I have two sheets in the same workbook, Sheet1 & Production. In "Sheet1" I have two columns A & B with date and well names. I need to loop through these rows and compare to production sheet. If well name and date are matched then get production figure. I managed to get it working but my real sheet has over 23,000 rows and over 200 columns on both sheets so I need a faster and more efficient way of doing this. my current code looks like this:

Private Sub CommandButton1_Click()

Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim iRow As Long
Dim jRow As Long
Dim kCol As Long

'Find the last non-blank row in Sheet1
iRow = Worksheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1).Row

'Find the last non-blank row in Production sheet
jRow = Worksheets("Production").Range("A" & Rows.Count).End(xlUp).Offset(1).Row

'Find the last non-blank column in Production sheet
kCol = Worksheets("Production").Cells(1, Columns.Count).End(xlToLeft).Column



For i = 2 To iRow
For j = 2 To jRow
For k = 2 To kCol


If Worksheets("Sheet1").Cells(i, 2) = Worksheets("Production").Cells(j, 1) Then

If Worksheets("Sheet1").Cells(i, 1) = Worksheets("Production").Cells(1, k) Then

Worksheets("Sheet1").Cells(i, 3) = Worksheets("Production").Cells(j, k)

End If
End If

Next k
Next j
Next i


End Sub







my "Sheet1" looks like this"
NameDateProduction
Well A01/01/2017
Well B01/01/2017
Well C01/01/2017
Well A02/01/2017
Well B02/01/2017
Well C02/01/2017
Well A03/01/2017
Well B03/01/2017
Well C03/01/2017

<tbody>
</tbody><colgroup><col><col><col></colgroup>



my "Production sheet looks like this:
Date Well AWell BWell C
05/02/2015110100
06/02/2015220200
07/02/2015330300
08/02/2015440400
09/02/2015550500
10/02/2015660600
11/02/2015770700
12/02/2015880800
13/02/2015990900
14/02/2015101001000
15/02/2015111101100
01/01/2017121201200
02/01/2017131301300
03/01/2017141401400

<tbody>
</tbody><colgroup><col><col span="3"></colgroup>



For short number of rows and columns the code works well. However it takes forever when I ran it with real data with over 20,000 rows. Please help me to optimize the loop so it can runs faster.


Regards,
 
Try this



Code:
[COLOR=#333333]Private Sub CommandButton1_Click()[/COLOR]

Dim i As Integer
Dim iRow As Long
Dim jRow As Long
Dim kCol As Long
Dim Rng1 As Range, Rng2 As Range

'Find the last non-blank row in Sheet1
iRow = Worksheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1).Row

'Find the last non-blank row in Production sheet
jRow = Worksheets("Production").Range("A" & Rows.Count).End(xlUp).Offset(1).Row

'Find the last non-blank column in Production sheet
kCol = Worksheets("Production").Cells(1, Columns.Count).End(xlToLeft).Column

With Sheets("Sheet1")
For i = 2 To iRow
Set Rng1 = Worksheets("Production").Range("A1:A" & jRow).Find(.Cells(i, 2))
Set Rng2 = Worksheets("Production").Range(Cells(1, 1).Address, Cells(1, kCol).Address).Find(.Cells(i, 1))

If Not Rng1 Is Nothing And Not Rng2 Is Nothing Then
.Cells(i, 3) = Worksheets("Production").Cells(Rng1.Row, Rng2.Column)
End If

Next i
End With

End Sub
 
Last edited:
Upvote 0

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Thanks but I have no clue with get and transform. An example would be useful.

Depending on your version of Excel the location on the ribbon is different. In My Excel 2016 from my Office 365 subscription I select the data, click on the Data tab of the ribbon and then on the left there is a group called Get & Transform Data with a button called "From Table/Range". CLick that button and confirm with the correct range. NExt the PowerQuery window will open with a new menu. Click on the Date column to select it (it will turn green). Then click on the Transform tab and click on the arrow to the right of "Unpivot columns" and select "Unpivot Other Columns". Now update the new column headers to what ever you like. Last step is clicking on the Home tab and on the dropdown called "Close and Load" on the far left and selecting "Close and load to". You can now decide whether to load to a table or use the data as the source for a pivottable directly.
 
Upvote 0

Forum statistics

Threads
1,214,833
Messages
6,121,864
Members
449,052
Latest member
Fuddy_Duddy

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
Back
Top