Question

I have been looking for a way in a previous post to create a macro that involves the use of a loop through the find function that would be something like this:

With ActiveSheet
    For i = 1 To LastEntity
    Cells.Find(What:="ENTITY(i)", After:=ActiveCell, LookIn:=xlFormulas, _
               MatchCase:=False, SearchFormat:=False).Activate
    SOME OPERATION
    Next i

Here "ENTITY(I)" is meant to mimic the procedure the following code uses to open multiple files:

    For i = 1 To .FoundFiles.Count
        Set wb = Workbooks.Open(Filename:=.FoundFiles(i))
        SOME OPERATION
    Next i

My question is: How can this functionality be extended to the find function properly? I am sure that the way I am writing it above is incorrect, but I am also sure there must be a way to do it. Any help would be appreciated!

EDIT:

Would the following change be possible if there was a need for a double loop?

Sub searchRangeAndDoStuff(ByVal ENTITY As String)

Dim xlRange As Excel.Range, varA As Variant, i As Long, x As Long

x = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

Set xlRange = ActiveSheet.Range(Cells(1, 1), Cells(x, 1))

set varA = xlRange.value

For i = LBound(varA, 1) To UBound(varA, 1)
    If InStr(1, varA(i, 1), ENTITY, vbTextCompare) Then
    Copy ENTITY
        For j = Beginning To End 
            If InStr(1, varA(j, 1), ITEM, vbTextCompare) Then
            Move cells down
            Move up one cell
            Paste ENTITY
            End If
        Next j
     End If
 Next i          

End Sub
Was it helpful?

Solution

This sub takes a search value called ENTITY. It gets the last row of data in column A, and assigns A1 : A & x to a variant, which allows me to loop through it quite quickly and efficiently. By default, the variant will have 2 dimensions, so it's a good idea to specify which you want it to loop though (to help you remember that it's 2 dimensional, if nothing else)

     Sub searchRangeAndDoStuff(ByVal ENTITY As String)

    'allocate for an excel range, a variant and 2 longs
    Dim xlRange As Excel.Range, varA As Variant, i As Long, x As Long

    'set one of the longs to the last row of data in column a
    x = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

    'set the range variable to this selection of cells
    Set xlRange = ActiveSheet.Range(Cells(1, 1), Cells(x, 1))
    'set the variant to the value of that range, producing a 2d variant array
    set varA = xlRange.value

   'move through the first dimension of the array (representing rows)
    For i = LBound(varA, 1) To UBound(varA, 1)
        'if you find the string value of the ENTITY variable in the cell somewhere
        If InStr(1, varA(i, 1), ENTITY, vbTextCompare) Then
            'do stuff
        End If
    Next i


    End Sub

If you need to preserve the row number and your range doesn't always start at the same offset from top, you can just use

Dim xlCell as Excel.Range

For Each xlCell in xlRange
'if in string, or if string compared, do something
'or assign the values and their row numbers to a 2d string array (clng() the row
'numbers), so you can continue to work with arrays
Next xlCell

The following is quite messy, and if you have lots of duplicate values, or the "paste to" range is the same as the "copy from" range, you are going to get a lot of weird behavior. But how you can correct this will depend on your actual project (I've commented out a few suggestions on how to manage some of this). It illustrates how to do something like what you propose in your edit:

Sub searchRangeAndDoStuff(ByVal ENTITY As String, ByRef CheckRange As Excel.Range)

Dim xlRange As Excel.Range, varA As Variant, x As Long
Dim xlCell As Excel.Range, xlCell1 As Excel.Range

x = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

Set xlRange = ActiveSheet.Range(Cells(1, 1), Cells(x, 1))

'please remember that if the check range is the same as the target range
'you are going to get some very wierd behaviour

For Each xlCell In xlRange
    'StrComp matches the full string, InStr simply returns true if a substring is
    'contained within the string - I don't know which one you want, but StrComp sounded
    'closer
    If StrComp(xlCell.Value, ENTITY, vbTextCompare) = 0 Then
    varA = xlCell.Value
        For Each xlCell1 In CheckRange
            'if not xlcell.row = xlcell1.row then
                If StrComp(xlCell.Value, xlCell1.Value, vbTextCompare) = 0 Then
                    xlCell1.Insert xlDown
                    xlCell1.Offset(-1, 0).Value = varA
                End If
            'end if
        Next xlCell1
        'xlCell.Delete
    End If
Next xlCell


End Sub
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top