Complex VBA to loop through each worksheet and extract text

[thedeadzeds]

Hi Guys,

I'm guessing this is not possible but I am trying to do the following:

I have a Worksheet called "Master" with the following column headings and I want to populate each row with data from the individual worksheets :

Name

Ref

Code

NI Code

Is there a way to loop through all worksheets in excluding Master, extract certain text and list it in the relevant columns in the 'master' sheet.

NI Code - Search the sheet for any cell containing 'NI -A' or 'NI-B' or 'NI C' and store in the NI code column. There will only be one of these per sheet so not all 3 codes.
Name - Search the sheet for any cell containing Employee Name and store the data from the cell to the right of this in the Name Column (for example Employee Name is in cell A4 so the Name will be in B4)
Ref - Search the sheet for any cell containing Ref and store the data from the cell to the right of this in the Ref Column.
Code- Search the sheet for any cell containing Code and store the data from the cell to the right of this in the Ref Column.

Hope this makes sense

 

[bobsan42]

Assuming 1 sheet = row of data. Not tested. No extra checks.
Try this:

Option Explicit
Option Base 0

Sub loopSheets()
    Dim mSh As Worksheet
    Set mSh = ThisWorkbook.Worksheets("Master")
    Dim saveRng As Range
    Set saveRng = mSh.Range("A2").Resize(1, 4)
    
    Dim results(0 To 3) As Variant
    Dim wsh As Worksheet
    Dim found As Range
    Dim lookFor As Variant, xLook As Variant
    Dim colOffset As Variant
    Dim i As Long, j As Long
    lookFor = Array("Employee Name", "Ref", "Code", Array("NI-A", "NI-B", "NI-C"))
    colOffset = Array(1, 1, 1, 0)
    
    For Each wsh In Worksheets
        If wsh Is mSh Then GoTo skipwsh
        Erase results
        For i = LBound(lookFor) To UBound(lookFor)
            If Not IsArray(lookFor(i)) Then
                xLook = Array(lookFor(i))
            Else
                xLook = lookFor(i)
            End If
            Set found = Nothing
            For j = LBound(xLook) To UBound(xLook)
                Set found = findValue(wsh, xLook(j), colOffset(i))
                If Not found Is Nothing Then
                    results(i) = found.Value
                    Exit For
                End If
            Next j
        Next i
        saveRng = results
        Set saveRng = saveRng.Offset(1)
skipwsh:
    Next wsh
    
    Set wsh = Nothing
    Set mSh = Nothing
    Set saveRng = Nothing
    Erase results
    Set found = Nothing
    lookFor = Null
    xLook = Null
    colOffset = Null
    
End Sub

Private Function findValue(ByRef sh As Worksheet, ByRef lookForValue As Variant, ByVal offsetColumns As Long) As Range
    Dim ur As Range
    Dim foundRange As Range
    Dim returnValue As Variant
    
    Set ur = sh.UsedRange
    Set foundRange = ur.Find(lookForValue, , xlValues, xlWhole)
    If Not foundRange Is Nothing Then _
        Set findValue = foundRange.Offset(0, offsetColumns)
End Function

 

[thedeadzeds]

Thanks, its nearly there but the 'master' worksheet looks like this? There are gaps between the data and one of the NI Codes randomly appeared in cell D2.

Employee Name	Ref	Code	NI Code
			NI - A
Name 1	2	FGTYH	NI - C
Name 2	3	GFDSF	NI - A
Name 3	20	HYGTF	NI - A

 

[bobsan42]

Well, it probably needs some fine-tuning, but I did it "on the fly" and with no sample data or file.

There are gaps between the data

This means that there are sheets where no relevant cells are found.

and one of the NI Codes randomly appeared in cell D2

on a sheet only the NI code cell is found, none of the others

Each line on the master sheet is a worksheet in the workbook.
Normally I would include the worksheet name in the output, like this:

Option Explicit
Option Base 0

Sub loopSheets()
    Dim mSh As Worksheet
    Set mSh = ThisWorkbook.Worksheets("Master")
    Dim saveRng As Range
    Set saveRng = mSh.Range("A2").Resize(1, 5)
   
    Dim results(0 To 4) As Variant
    Dim wsh As Worksheet
    Dim found As Range
    Dim lookFor As Variant, xLook As Variant
    Dim colOffset As Variant
    Dim i As Long, j As Long
    lookFor = Array("Employee Name", "Ref", "Code", Array("NI-A", "NI-B", "NI-C"))
    colOffset = Array(1, 1, 1, 0)
   
    For Each wsh In Worksheets
        If wsh Is mSh Then GoTo skipwsh
        Erase results
        results(4) = wsh.Name
        For i = LBound(lookFor) To UBound(lookFor)
            If Not IsArray(lookFor(i)) Then
                xLook = Array(lookFor(i))
            Else
                xLook = lookFor(i)
            End If
            Set found = Nothing
            For j = LBound(xLook) To UBound(xLook)
                Set found = findValue(wsh, xLook(j), colOffset(i))
                If Not found Is Nothing Then
                    results(i) = found.Value
                    Exit For
                End If
            Next j
        Next i
        saveRng = results
        Set saveRng = saveRng.Offset(1)
skipwsh:
    Next wsh
   
    Set wsh = Nothing
    Set mSh = Nothing
    Set saveRng = Nothing
    Erase results
    Set found = Nothing
    lookFor = Null
    xLook = Null
    colOffset = Null
   
End Sub

Private Function findValue(ByRef sh As Worksheet, ByRef lookForValue As Variant, ByVal offsetColumns As Long) As Range
    Dim ur As Range
    Dim foundRange As Range
    Dim returnValue As Variant
   
    Set ur = sh.UsedRange
    Set foundRange = ur.Find(lookForValue, , xlValues, xlWhole)
    If Not foundRange Is Nothing Then _
        Set findValue = foundRange.Offset(0, offsetColumns)
End Function