Home > other >  Can you use .Find to search if a cell contains part of a string?
Can you use .Find to search if a cell contains part of a string?

Time:10-13

I am trying to use the .Find function to find two strings and determine which row they are in. For this example the two strings that I am looking for are "Wavelength" and "Test-Config" as shown in the rowindex = getrowindex(sysnum, "Wavelength", "Test-Config") line. For this case it works fine, however, for my next line rowindex_1 = getrowindex(sysnum, "Wavelength Range", "ModTst,FunctionalTest,ShpPrp") I want to use .Find to see the row that has column B value of "Wavelength Range" and column C that contains "FunctionalTest" without having the have the full "ModTst,FunctionalTest,ShpPrp" be included as the input string to the function getrowindex

I have attached all my code. It currently can run up until rowindex_1 = getrowindex(sysnum, "Wavelength Range", "ModTst,FunctionalTest,ShpPrp") which it stops at since in Column C there is no cell value of ModTst,FunctionalTest,ShpPrp as it is case sensitive. However, I want it to still go ahead and say if column C cell value = FunctionalTest then find that row index with Wavelength Range and FunctionalTest

Public Sub Main()
Dim wb As Workbook, ws As Worksheet, dict As Object, sysrow As Integer, sysnum As String, wsName As String
Dim wbSrc As Workbook, SDtab As Worksheet
Dim colindex As Long
Dim spectyp As Long, specmin As Long, specmax As Long
Dim sweep_value As Double, sweep_value_max As Double
Dim rowindex As Double, rowindex_1 As Double

Dim Value As Double
Set wb = ThisWorkbook

Set ws = wb.ActiveSheet 

Set wbSrc = Workbooks.Open("Q:Specification and Configuration Document.xlsx")
Set dict = CreateObject("scripting.dictionary")

Dim cell As Range
For Each cell In ws.Range("E2", ws.Cells(ws.Rows.Count, "E").End(xlUp)).Cells
    sysnum = cell.Value
    sysrow = cell.Row
    syscol = cell.Column

    If sysnum = "" Then
    MsgBox "No WD number, skipping to next row."
    GoTo Skip
    End If
If Not dict.Exists(sysnum) Then 
    dict.Add sysnum, True
    If Not SheetExists(sysnum, ThisWorkbook) Then
        wsName = cell.EntireRow.Columns("D").Value 
        If SheetExists(wsName, wbSrc) Then 
            wbSrc.Worksheets(wsName).Copy after:=ws 
            wb.Worksheets(wsName).name = sysnum 
        Set SDtab = ThisWorkbook.Worksheets(ws.Index   1) 
            Debug.Print SDtab.name
            
        End If

spectyp = getcolumnindex(SDtab, "Spec Typical") 
specmin = getcolumnindex(SDtab, "SPEC min")
specmax = getcolumnindex(SDtab, "SPEC max")

 Sheets(1).Select 

' Wavelength Tuning Range Section
colindex = getcolumnindex(ws, "Tuning Range (nm)")
Value = getjiradata(ws, sysrow, colindex) ' wavelength tuning range value
rowindex = getrowindex(sysnum, "Wavelength Range", "Test-Config-OCT")
rowindex_1 = getrowindex(sysnum, "Wavelength Range", "ModTst,FunctionalTest,ShpPrp")

End Sub 

Function SheetExists(SheetName As String, wb As Workbook) 
   On Error Resume Next
   SheetExists = Not wb.Sheets(SheetName) Is Nothing
End Function

Function getcolumnindex(sht As Worksheet, colname As String) 
Dim paramname As Range
Set paramname = sht.Range("A1:Z2").Find(What:=colname, Lookat:=xlWhole, LookIn:=xlFormulas, searchorder:=xlByColumns, searchdirection:=xlPrevious, MatchCase:=True)
    If Not paramname Is Nothing Then
        getcolumnindex = paramname.Column
    End If
End Function

Function getjiradata(sht As Worksheet, WDrow As Integer, parametercol As Long) 
     getjiradata = sht.Cells(WDrow, parametercol)
End Function

Function getrowindex(WDnum As Variant, parametername As String, routingname As String)
Dim parameter_row As Range, ws As Worksheet, rowname As Range, addr As String

Set ws = ThisWorkbook.Worksheets(WDnum)
Set rowname = ws.Columns("B").Find(What:=parametername, Lookat:=xlWhole, LookIn:=xlFormulas, MatchCase:=True) 

If Not rowname Is Nothing Then 
        addr = rowname.Address 
    Do
        If rowname.Offset(0, 1).Value = routingname Then 
            getrowindex = rowname.Row
            Exit Do 
        End If
        Set rowname = ws.Columns("B").FindNext(after:=rowname)
    Loop While rowname.Address <> addr 
End If
End Function

CodePudding user response:

Like this (added a couple of parameters to control whether exact or partial match is used). Match type defaults to exact.

Sub Tester()

    Dim rnum As Long
    
    rnum = getrowindex("Sheet1", "Wavelength Range", "FunctionalTest", partialSecond:=True)
    
    Debug.Print rnum

End Sub


'Find the row number on sheet `WDnum` where ColB matches `parametername` and
'  ColC matches `routingname`.  Use exact or partial match based on optional parameters
'  `partialFirst` and `partialSecond`
Function getrowindex(WDnum As Variant, parametername As String, routingname As String, _
                     Optional partialFirst As Boolean = False, Optional partialSecond As Boolean = False)
    Dim parameter_row As Range, ws As Worksheet, rowname As Range, addr As String
    
    Set ws = ThisWorkbook.Worksheets(WDnum)
    Set rowname = ws.Columns("B").Find(What:=parametername, _
        Lookat:=IIf(partialFirst, xlPart, xlWhole), LookIn:=xlFormulas, MatchCase:=True)
    
    If Not rowname Is Nothing Then
            addr = rowname.Address
            If partialSecond Then routingname = "*" & routingname & "*"
        Do
            If rowname.Offset(0, 1).Value Like routingname Then
                getrowindex = rowname.Row
                Exit Do
            End If
            Set rowname = ws.Columns("B").FindNext(after:=rowname)
        Loop While rowname.Address <> addr
    End If
End Function
  • Related