Excel VBA :: 在循环中查找函数

Question

I'm trying to loop through several worksheets that contain some source data that has to be copied to one main sheet, called "PriorityList" here. First of all, the sub is not working and I think the error is somewhere in the " find "-method. Second, the sub takes quite long to run, and I think this is maybe because the "find"-method searches through the whole sheet instead of only the relevant range?

Thank you very much for your answers!

Patrick

Sub PriorityCheck()
'Sub module to actualise the PriorityList

Dim CurrWS As Long, StartWS As Long, EndWS As Long, ScheduleWS As Long
StartWS = Sheets("H_HS").Index
EndWS = Sheets("E_2").Index

Dim SourceCell As Range, Destcell As Range

For CurrWS = StartWS To EndWS

    For Each SourceCell In Worksheets(CurrWS).Range("G4:G73")

        On Error Resume Next

        'Use of the find method
        Set Destcell = Worksheets(CurrWS).Cells.Find(What:=SourceCell.Value, After:=Worksheets("PriorityList").Range("A1"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

        'Copying relevant data from source sheet to main sheet
        If Destcell <> Nothing Then
            Destcell.Offset(0, 2).Value = SourceCell.Offset(0, 5).Value + Destcell.Offset(0, 2).Value
            If SourceCell.Offset(0, 3).Value = "x" Then Destcell.Offset(0, 3).Value = "x"
            End If
        End If

        On Error GoTo 0

    Next SourceCell

Next CurrWS

End Sub

Answer 1

here short sample how to use 'Find' method to find the first occurrence of the source.Value in the priorityList .

Source cell is one of the cells from the range "G4:G73" and priorityList is used range on "PriorityList" sheet. Hope this helps.

Public Sub PriorityCheck()
    Dim source As Range
    Dim priorityList As Range
    Dim result As Range

    Set priorityList = Worksheets("PriorityList").UsedRange

    Dim i As Long
    For i = Worksheets("H_HS").Index To Worksheets("E_2").Index
        For Each source In Worksheets(i).Range("G4:G73")
            Set result = priorityList.Find(What:=source.Value)
            If (Not result Is Nothing) Then
                ' do stuff with result here ...
                Debug.Print result.Worksheet.Name & ", " & result.Address
            End If
        Next source
    Next i
End Sub

Answer 2

Here is an approach using arrays . You save each range into an array, then iterate through array to satisfy your if-else condition. BTW IF you want to find the exact line with code error, then you must comment On Error Resume Next line.. :) Further, you can simply store the values into a new array, dump everything else into the main sheet later after iterating through all the sheets instead of going back and forth to sheets, code, sheets..code..

Dim sourceArray as Variant, priorityArray as Variant
'-- specify the correct priority List range here
'-- if multi-column then use following method
priorityArray = Worksheets(CurrWS).Range("A1:B10").Value
'-- if single column use this method
' priorityArray = WorkSheetFunction.Transpose(Worksheets(CurrWS).Range("A1:A10").Value)

For CurrWS = StartWS To EndWS
   On Error Resume Next    
   sourceArray = Worksheets(CurrWS).Range("G4:J73").Value
   For i = Lbound(sourceArray,1) to UBound(sourceArray,1)
     For j = Lbound(priorityArray,1) to UBound(priorityArray,1)
        If Not IsEmpty(vArr(i,1)) Then    '-- use first column
        '-- do your validations here..
        '-- offset(0,3) refers to J column from G column, that means
        '---- sourceArray(i,3)...
        '-- you can either choose to update priority List sheet here or
        '---- you may copy data into a new array which is same size as priorityArray
        '------ as you deem..
        End If
     Next j
   Next i       
Next CurrWS

PS: Not front of a MS Excel installed machine to try this out. So treat above as a code un-tested. For the same reason I couldn't run your find method. But it seems odd. Don't forget when using match or find it's important to do proper error handling. Try checking out [ find based solutions provided here.

• VBA in find function runtime error 91
• Excel 2007 VBA find function. Trying to find data between two sheets and put it in a third sheet

I have edited the initial code to include the main logic using two array. Since you need to refer to values in J column of source sheets, you will need to adjust source array into a two-dimensional array. So you can do the validations using first column and then retrieve data as you desire.

Answer 3

For everyone maybe interested, this is the code version that I finally used (pretty similar to the version suggested by Daniel Dusek):

Sub PriorityCheck()
    Dim Source As Range
    Dim PriorityList As Range
    Dim Dest As Range

    Set PriorityList = Worksheets("PriorityList").UsedRange

    Dim i As Long

    For i = Worksheets("H_HS").Index To Worksheets("S_14").Index
        For Each Source In Worksheets(i).Range("G4:G73")
        If Source <> "" Then
            Set Dest = PriorityList.Find(What:=Source.Value)
            If Not Dest Is Nothing Then
                If Dest <> "" Then
                    Dest.Offset(0, 2).ClearContents
                    Dest.Offset(0, 2).Value = Source.Offset(0, 5).Value + Dest.Offset(0, 2).Value
                End If
            If Source.Offset(0, 3).Value = "x" Then Dest.Offset(0, 3).Value = "x"
                Debug.Print Dest.Worksheet.Name & ", " & Dest.Address
            End If
        End If
        Next Source
    Next i

    MsgBox "Update Priority List completed!"

End Sub