Reputation: 926
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
Upvotes: 0
Views: 134
Reputation: 2852
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
Upvotes: 1