VBA Loop within loop error

[DFlem]

Hi, I've been having trouble with part of my code. It seems to be partially working. I am creating a loop within a loop. I am searching for the work order number from "this workbook" in a different workbook. I have listed out the tasks of my code below. For some reason, it is operating at 100%. During my data validations, I found that the code is sometimes generating a po number that had no relation to the work order it was supposed to be looking up.

-take each work order from "maximo" worksheet (this workbook) column B
-Search the for the work order in the active sheet column B
-If multiple matchs are found, search column c for the newest date
-once found the newest date, select the value in column A of that row
-input the value into the corresponding column a of "maximo" worksheet (this workbook) that the work order was orginally selected to search for.
-Move on to the next cell in "maximo" worksheet (this workbook) to start loop again.


Any help would be greatly appreciated. Code pasted below.. Having trouble installing the plug in


Sub PoSelection()

Dim mlastRow As Long
Dim mlastColumn As Long

Dim plastRow As Long
Dim plastColumn As Long

Dim mwo As String
Dim WO As String
Dim Po As String
Dim newestDate As Date

Dim pwoRow As Long 'Po tracker work order
Dim mwoRow As Long 'Maximo file work order

mlastRow = ThisWorkbook.Worksheets("Maximo").Cells(Rows.Count, 1).End(xlUp).row 'Maximo (this workbook) ws range
mlastColumn = ThisWorkbook.Worksheets("Maximo").Cells(Columns.Count, 3).End(xlToLeft).Column

plastRow = Cells(Rows.Count, 1).End(xlUp).row 'po tracker ws range
plastColumn = Cells(Columns.Count, 3).End(xlToLeft).Column

For mwoRow = 2 To mlastRow

mwo = ThisWorkbook.Worksheets("Maximo").Range("B" & mwoRow).Value

For pwoRow = 2 To plastRow

If InStr(1, Range("B" & pwoRow).Value, mwo) > 0 Then

If CDate(Range("C" & pwoRow).Value) > newestDate Then

Po = Range("A" & pwoRow).Value
WO = Range("B" & pwoRow).Value
newestDate = CDate(Range("C" & pwoRow).Value)

End If

End If

Next pwoRow

ThisWorkbook.Worksheets("Maximo").Range("A" & mwoRow).Value = Po

Next mwoRow

End Sub

 

[offthelip]

I think your probelm is because you are not resetting the newest date at the start of each loop though the active sheet, so add this line just infront of the loop

newestdate= 0              ' add this line just before
For pwoRow = 2 To plastRow

 

[DanteAmor]

I also think you should reference column B in this line, in case column A has no data:
mlastRow = ThisWorkbook.Worksheets("Maximo").Cells(Rows.Count, 1).End(xlUp).row 'Maximo (this workbook) ws range
for example:

mlastRow = ThisWorkbook.Worksheets("Maximo").Cells(Rows.Count, "B").End(xlUp).row

Your macro reads a record from your "maximo" sheet and then loops through all the records on the activesheet.
That means that if you have 10 records in the "maximo" sheet and 100 records in the activesheet, it means that your macro performs a thousand reads.

I recommend the following code. What it does is store in an index (scripting.dictionary) the work order, the value and the maximum date. The cycle, continuing with my example, only reads 10 records from the "maximo" sheet.

The second cycle reads, continuing with my example, only 100 records, searches the index for the order and obtains the maximum date immediately, in summary the macro performed 110 readings, while your macro performed 1000 readings. It is only an example, it is clear that if you have more records in your sheets, then the readings with your macro will increase.

Try this code:

Sub PoSelection()
  Dim dic As Object
  Dim i As Long
  Dim arr As Variant
 
  Set dic = CreateObject("Scripting.Dictionary")
  arr = Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).Value   'activesheet
 
  For i = 1 To UBound(arr, 1)
    If Not dic.exists(arr(i, 2)) Then
      dic(arr(i, 2)) = arr(i, 1) & "|" & arr(i, 3)      'store order = value | date
    Else
      If arr(i, 3) > CDate(Split(dic(arr(i, 2)), "|")(1)) Then
        dic(arr(i, 2)) = arr(i, 1) & "|" & arr(i, 3)    'store max date
      End If
    End If
  Next
 
  With ThisWorkbook.Worksheets("Maximo")
    For i = 2 To .Range("B" & Rows.Count).End(3).Row
      If dic.exists(.Range("B" & i).Value) Then
        .Range("A" & i).Value = Split(dic(.Range("B" & i).Value), "|")(0)
      End If
    Next i
  End With
End Sub

If you want to know more about scripting dictionary, check out the following:

---
The following is an example of copying data from one workbook to another using an array and the scripting dictionary.

---

Note Code Tag:
In future please use code tags when posting code.
How to Post Your VBA Code it makes your code easier to read and copy and it also maintains VBA formatting.