Copy rows between two strings based on search condition - vba

Question

I have to search column B for a certain string and return a specific range of cells for all occurrences of the string in the file. I have code which searches and finds all occurrences of the string but have difficulty with copying into a new sheet the specific range of cells between Path and Owner. The catch is that the row numbers between Path and Owner are dynamic.
Excel structure
(including expected results for search string Kevin).
Macro
Sub FindString()
Dim intS As Integer
Dim rngC As Range
Dim strToFind As String, FirstAddress As String
Dim wSht As Worksheet
Application.ScreenUpdating = True
intS = 1
Set wSht = Worksheets("Search Results")
strToFind = Range("I3").Value 'This is where I obtain the string to be searched
With ActiveSheet.Range("B1:B999999")
Set rngC = .Find(what:=strToFind, LookAt:=xlPart)
If Not rngC Is Nothing Then
FirstAddress = rngC.Address
Do
(
'need help to find copy rows from column B based on values in column A
)
intS = intS + 1
Set rngC = .FindNext(rngC)
Loop While Not rngC Is Nothing And rngC.Address <> FirstAddress
End If
End With
Please help me or guide me as I'm a newbie to Excel.

Answer 1

This code will display the paths found (variable sPath), this is untested:
Sub FindString()
'Dim intS As Integer
Dim rngC As Range
Dim strToFind As String, FirstAddress As String
Dim wSht As Worksheet, lRowPath As Long, lRowOwner As Long, i As Long, sPath As String
'Application.ScreenUpdating = True
'intS = 1
Set wSht = Worksheets("Search Results")
strToFind = Range("I3").Value 'This is where I obtain the string to be searched
'With ActiveSheet.Range("B1:B999999")
With ActiveSheet.Range("B:B")
Set rngC = .Find(what:=strToFind, LookAt:=xlPart)
If Not rngC Is Nothing Then
FirstAddress = rngC.Address
Do
' Find the "Path:" above the found cell, note that offset too much is not handled: Cells(-1,1)
i = -1
Do Until InStr(1, rngC.Offset(i, -1).Value, "Path", vbTextCompare) > 0
i = i - 1
Loop
lRowPath = rngC.Row + i
' Find the Owner row above the found cell
i = -1
Do Until InStr(1, rngC.Offset(i, -1).Value, "Owner", vbTextCompare) > 0
i = i - 1
Loop
lRowOwner = rngC.Row + i
'need help to find copy rows from column B based on values in column A
sPath = ""
For i = lRowPath To lRowOwner - 1
sPath = sPath & ActiveSheet.Cells(i, "B").Value ' <-- Update
Next
Debug.Print "Searching " & strToFind; " --> " & sPath
'intS = intS + 1
Set rngC = .Find(what:=strToFind, After:=rngC, LookAt:=xlPart)
Loop Until rngC.Address = FirstAddress
End If
End With
End Sub

Answer 2

I suggest you load everything to memory first, then do your searches and manipulations.
You could use a user-defined type to store info about your paths:
Type PathPermissionsType
pth As String
owner As String
users As Dictionary
End Type
Note: to use Dictionary you need to go to Tools>References and set a checkmark next to Microsoft Scripting Runtime.
You can load all your info using something like this:
Function LoadPathPermissions() As PathPermissionsType()
Dim rngHeaders As Range
Dim rngData As Range
Dim iPath As Long
Dim nPath As Long
Dim iRow As Long
Dim nRow As Long
Dim vHeaders As Variant
Dim vData As Variant
Dim pathPermissions() As PathPermissionsType
Set rngHeaders = Range("A1:A12") 'or wherever
Set rngData = rngHeaders.Offset(0, 1)
'Load everything to arrays
vHeaders = rngHeaders.Value
vData = rngData.Value
nRow = UBound(vData, 1)
nPath = WorksheetFunction.CountIf(rngHeaders, "Path:")
ReDim pathPermissions(1 To nPath)
iRow = 1
'Look for first "Path:" header.
Do Until InStr(vHeaders(iRow, 1), "Path") <> 0
iRow = iRow + 1
Loop
'Found "Path:" header.
For iPath = 1 To nPath
With pathPermissions(iPath)
'Now look for "Owner:" header, adding to the path until it is found.
Do Until InStr(vHeaders(iRow, 1), "Owner") <> 0
.pth = .pth & vData(iRow, 1)
iRow = iRow + 1
Loop
'Found "Owner:" header.
.owner = vData(iRow, 1)
'"User:" header is on next row:
iRow = iRow + 1
'Now add users to list of users:
Set .users = New Dictionary
Do Until InStr(vHeaders(iRow, 1), "Path") <> 0
.users.Add vData(iRow, 1), vData(iRow, 1)
iRow = iRow + 1
If iRow > nRow Then Exit Do ' End of data.
Loop
End With
Next iPath
LoadPathPermissions = pathPermissions
End Function
Example usage:
Dim pathPermissions() As PathPermissionsType
pathPermissions = LoadPathPermissions()
Then to get an array containing the paths for a given user:
Function GetPathsForUser(ByVal user As String, pathPermissions() As PathPermissionsType) As String()
Dim iPath As Long
Dim iPathsWithPermission As Long
Dim nPathsWithPermission As Long
Dim pathsWithPermission() As String
For iPath = LBound(pathPermissions) To UBound(pathPermissions)
If pathPermissions(iPath).users.Exists(user) Then nPathsWithPermission = nPathsWithPermission + 1
Next iPath
ReDim pathsWithPermission(1 To nPathsWithPermission)
iPathsWithPermission = 0
For iPath = LBound(pathPermissions) To UBound(pathPermissions)
If pathPermissions(iPath).users.Exists(user) Then
iPathsWithPermission = iPathsWithPermission + 1
pathsWithPermission(iPathsWithPermission) = pathPermissions(iPath).pth
End If
Next iPath
GetPathsForUser = pathsWithPermission
End Function
Example usage:
Dim pathPermissions() As PathPermissionsType
Dim pathsWithPermission() As String
pathPermissions = LoadPathPermissions()
pathsWithPermission = GetPathsForUser("Kevin", pathPermissions)
Now pathsWithPermission is an array containing the paths for which Kevin is listed as user. Note that I haven't dealt with edge cases, like if Kevin is a not a user for any paths, etc. Up to you to do that.
Finally you can write the contents of that array to your sheet.