Looping Instr in VBA

G

gripper

Board Regular
Joined
Oct 29, 2002
Messages
176
I am working on a code that I am having issues with and I believe it is with my instr criteria.

In addition I would like to also capture the two rows above the true instr statement and one row below in order to keep everything in context on the output sheet.

I have a spreadsheet that that I update each day that is usually around 10K to 16K rows. The rows have many columns but in column 38 I run code and if the data is true based on the criteria it will place a string starting with "L-" along with some random numbers in the cell and then it will color the entire row to draw attention to the user of that critical information.

In this daily data set there are usually about 30 rows of data that will match certain criteria and insert into column 38 the "L-" coding.

Raw data is in a sheet called ("R-2.25")

My code below takes this entire sheet and dumps it into an array. All this seems to be fine to this point.

I now want it to iterate through this array looking at column 38 for this "L-" string followed by the various random numbers. As it finds a true row it will dump that data to the "L_Review" sheet.

Plot twist. After resolving my instr search method I would like to grab the 3 rows above and 2 rows below to keep everything in context during the review process.

Here is the code I have thus far.

Thank you for the assistance

VBA Code: 
Sub l_LoopArray()

' loads entire sheet into an array
' It will clear the dump sheet first
' rw = row counter (aka "i")
' rprw is short for report row starting place

Dim startTime As Double
Dim secondsElapsed As Double


Sheets("L_Review").Cells.Clear

oarray = Sheets("R-2.25").Cells(1, 1).CurrentRegion
startTime = Timer

rprw = 2
For rw = 2 To UBound(oarray)
     If oarray(rw, 38) = InStr(Cells(rw, 38).Value, "L-") Then
    
          For cl = 1 To UBound(oarray, 2)
               Sheets("L_Review").Cells(rprw, cl) = oarray(rw, cl)
          Next
          rprw = rprw + 1
     End If
    
Next

secondsElapsed = Round(Timer - startTime, 5)

MsgBox " Rows Processed in " & secondsElapsed & " Seconds", vbInformation

End Sub
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Sort by date Sort by votes
How about
VBA Code: 
Sub gripper()
   Dim startTime As Double
   Dim secondsElapsed As Double
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long

   startTime = Timer
   Sheets("L_Review").Cells.Clear
   Ary = Sheets("R-2.25").Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To UBound(Ary), 1 To UBound(Ary, 2))
   
   For r = 2 To UBound(Ary)
      If InStr(1, Ary(r, 38), "L-", vbTextCompare) > 0 Then
         nr = nr + 1
         For c = 1 To UBound(Ary, 2)
            Nary(nr, c) = Ary(r, c)
         Next c
      End If
   Next r
   Sheets("L_Review").Range("A2").Resize(nr, UBound(Nary, 2)).Value = Nary

secondsElapsed = Round(Timer - startTime, 5)

MsgBox " Rows Processed in " & secondsElapsed & " Seconds", vbInformation

End Sub
 
Upvote 0
gripper said:
Plot twist. After resolving my instr search method I would like to grab the 3 rows above and 2 rows below to keep everything in context during the review process.
Click to expand...
Is it possible that the 3 rows above one of the "L-" rows could overlap with the two rows below a previous "L-" row? If so, would you still want the two 5-row copies to be placed one under the other or would you like a blank row between all 5-row sets so that they are more easily reviewable?

Also, is it possible for the first "L-" row to be at the top of your data such that there are not 3 rows of data above it? If so, what would you want retrieved?
 
Upvote 0
Rick Rothstein,

You are on the correct path. But the 3 above and then the trigger row and then 2 underneath for a total of 6. I was thinking some type offset but I need to dig for that info. I just thought I would ask.

Thank you.
 
Upvote 0
gripper said:
Rick Rothstein,

You are on the correct path. But the 3 above and then the trigger row and then 2 underneath for a total of 6. I was thinking some type offset but I need to dig for that info. I just thought I would ask.

Thank you.
Click to expand...
Rick to further answer your question there would be no collision of data with any over laps The nature of the data is such that this is avoided with only pulling out these small samples of data.

So I am hoping for some sort of code to pull the trigger row and the entire 3 rows above and 2 rows under with a blank row between each set for delineation

Thank you
 
Upvote 0
Fluff said:
How about
VBA Code: 
Sub gripper()
   Dim startTime As Double
   Dim secondsElapsed As Double
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long

   startTime = Timer
   Sheets("L_Review").Cells.Clear
   Ary = Sheets("R-2.25").Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To UBound(Ary), 1 To UBound(Ary, 2))
  
   For r = 2 To UBound(Ary)
      If InStr(1, Ary(r, 38), "L-", vbTextCompare) > 0 Then
         nr = nr + 1
         For c = 1 To UBound(Ary, 2)
            Nary(nr, c) = Ary(r, c)
         Next c
      End If
   Next r
   Sheets("L_Review").Range("A2").Resize(nr, UBound(Nary, 2)).Value = Nary

secondsElapsed = Round(Timer - startTime, 5)

MsgBox " Rows Processed in " & secondsElapsed & " Seconds", vbInformation

End Sub
Click to expand...
 
Upvote 0
Fluff,

Thank you for the code. I was able to test it and it works fine. I am hoping to go a step further though and somehow capture the 3 rows above the row with the "L-" trigger and the 2 below this trigger for a total of 6 row blocks with a blank row between them as the populate the "L-Review" sheet. Would you have any suggestion on how to pursue this?

Thank you for the help you code is solid
 
Upvote 0
Does this do what you want...
VBA Code: 
Sub L1Cells()
  Dim Ar As Range
  With Sheets("R-2.25").Range("AL1", Sheets("R-2.25").Cells(Rows.Count, "AL").End(xlUp))
    .Replace "L1-", "=L1-", xlPart, , False, , False, False
    For Each Ar In .SpecialCells(xlFormulas, xlErrors).Areas
      Sheets("L_Review").Cells(Rows.Count, "A").End(xlUp).Offset(2).Resize(6).EntireRow = Ar.EntireRow.Offset(-3).Resize(6).Value
    Next
    .Replace "=", "", xlPart
    Sheets("L_Review").Columns("AL").Replace "=", "", xlPart
  End With
End Sub
 
Upvote 0
This will grab the 3 rows above & 2 below
VBA Code: 
Sub gripper()
   Dim startTime As Double
   Dim secondsElapsed As Double
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long, pr As Long

   startTime = Timer
   Sheets("L_Review").Cells.Clear
   Ary = Sheets("R-2.25").Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To UBound(Ary), 1 To UBound(Ary, 2))
   
   For r = 2 To UBound(Ary)
      If InStr(1, Ary(r, 38), "L-", vbTextCompare) > 0 Then
         For pr = r - 3 To r + 2
            nr = nr + 1
            For c = 1 To UBound(Ary, 2)
               Nary(nr, c) = Ary(pr, c)
            Next c
         Next pr
      End If
   Next r
   Sheets("L_Review").Range("A2").Resize(nr, UBound(Nary, 2)).Value = Nary

   secondsElapsed = Round(Timer - startTime, 5)

   MsgBox " Rows Processed in " & secondsElapsed & " Seconds", vbInformation

End Sub
 
Upvote 0
Solution
Fluff said:
This will grab the 3 rows above & 2 below
VBA Code: 
Sub gripper()
   Dim startTime As Double
   Dim secondsElapsed As Double
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long, pr As Long

   startTime = Timer
   Sheets("L_Review").Cells.Clear
   Ary = Sheets("R-2.25").Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To UBound(Ary), 1 To UBound(Ary, 2))
  
   For r = 2 To UBound(Ary)
      If InStr(1, Ary(r, 38), "L-", vbTextCompare) > 0 Then
         For pr = r - 3 To r + 2
            nr = nr + 1
            For c = 1 To UBound(Ary, 2)
               Nary(nr, c) = Ary(pr, c)
            Next c
         Next pr
      End If
   Next r
   Sheets("L_Review").Range("A2").Resize(nr, UBound(Nary, 2)).Value = Nary

   secondsElapsed = Round(Timer - startTime, 5)

   MsgBox " Rows Processed in " & secondsElapsed & " Seconds", vbInformation

End Sub
Click to expand...
Fluff said:
This will grab the 3 rows above & 2 below
VBA Code: 
Sub gripper()
   Dim startTime As Double
   Dim secondsElapsed As Double
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long, pr As Long

   startTime = Timer
   Sheets("L_Review").Cells.Clear
   Ary = Sheets("R-2.25").Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To UBound(Ary), 1 To UBound(Ary, 2))
  
   For r = 2 To UBound(Ary)
      If InStr(1, Ary(r, 38), "L-", vbTextCompare) > 0 Then
         For pr = r - 3 To r + 2
            nr = nr + 1
            For c = 1 To UBound(Ary, 2)
               Nary(nr, c) = Ary(pr, c)
            Next c
         Next pr
      End If
   Next r
   Sheets("L_Review").Range("A2").Resize(nr, UBound(Nary, 2)).Value = Nary

   secondsElapsed = Round(Timer - startTime, 5)

   MsgBox " Rows Processed in " & secondsElapsed & " Seconds", vbInformation

End Sub
Click to expand...
Fluff

Excellent code this is very fast. Way faster than just doing a general loop of ranges. I love arrays.

Wanted to give you some feed back on performance I don't see much of this on this board (or other boards for that matter) I have this on a data set of 55,000 rows and 58 columns. The entire code runs on this data sets and completes in 0.72 seconds. (7/10's of 1 second) Arrays speeds up the process exponentially.

For clarity for others I adjusted the code and added 1 line to add a blank row between the data groups for easier viewing (see below)

Thank you so much for the help. You my friend are an excellent problem solver.

Thanks again!

VBA Code: 
Sub filterWithSpaces()
   Dim startTime As Double
   Dim secondsElapsed As Double
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long, pr As Long

   startTime = Timer
   Sheets("L_Review").Range("A2:ZZ" & Rows.count).Cells.ClearContents
   Ary = Sheets("R-2.25").Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To UBound(Ary), 1 To UBound(Ary, 2))
   
   For r = 2 To UBound(Ary)
      If InStr(1, Ary(r, 38), "L-", vbTextCompare) > 0 Then
      nr = nr + 1 ' adds a space to separate grouping of rows <----------------Added this
      For pr = r - 3 To r + 2 'Captures 3 rows above and 2 rows below
            nr = nr + 1
            For c = 1 To UBound(Ary, 2)
               Nary(nr, c) = Ary(pr, c)
            Next c
         Next pr
      End If
    Next r

   Sheets("L_Review").Range("A2").Resize(nr, UBound(Nary, 2)).Value = Nary

   secondsElapsed = Round(Timer - startTime, 5)

   MsgBox " Rows Processed in " & secondsElapsed & " Seconds", vbInformation

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Solved
Using InStr to Find Matches Between Columns
Replies
1
Views
540
Farscape2020
F
M
  • Solved
Need help modify to pick any first number of my choice
Replies
6
Views
264
motilulla
M
S
  • Question
Autofilter in VBA when criteria is has more words separated by a comma in 2 sheets
Replies
0
Views
473
shafiey
S
C
  • Question
Loop validation, copy output from same range and paste in different ranges
Replies
1
Views
386
RoryA
RoryA
E
  • Question
Help Cleaning Up / Optimizing VBA Code
Replies
6
Views
281
offthelip
O

Forum statistics

Threads
1,214,832
Messages
6,121,845
Members
449,051
Latest member
excelquestion515

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top