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"
<tbody>
</tbody><colgroup><col><col><col></colgroup>
my "Production sheet looks like this:
<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,
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"
Name | Date | Production |
Well A | 01/01/2017 | |
Well B | 01/01/2017 | |
Well C | 01/01/2017 | |
Well A | 02/01/2017 | |
Well B | 02/01/2017 | |
Well C | 02/01/2017 | |
Well A | 03/01/2017 | |
Well B | 03/01/2017 | |
Well C | 03/01/2017 |
<tbody>
</tbody><colgroup><col><col><col></colgroup>
my "Production sheet looks like this:
Date | Well A | Well B | Well C |
05/02/2015 | 1 | 10 | 100 |
06/02/2015 | 2 | 20 | 200 |
07/02/2015 | 3 | 30 | 300 |
08/02/2015 | 4 | 40 | 400 |
09/02/2015 | 5 | 50 | 500 |
10/02/2015 | 6 | 60 | 600 |
11/02/2015 | 7 | 70 | 700 |
12/02/2015 | 8 | 80 | 800 |
13/02/2015 | 9 | 90 | 900 |
14/02/2015 | 10 | 100 | 1000 |
15/02/2015 | 11 | 110 | 1100 |
01/01/2017 | 12 | 120 | 1200 |
02/01/2017 | 13 | 130 | 1300 |
03/01/2017 | 14 | 140 | 1400 |
<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,