Copy data based on cell value

[Declanscully]

I was helped out with and subsequentially modified a bit. This works but I was wondering if there is a way to modify it so that the BOLDED section can be more dynamic.

Essentially I want to try is:
Sequentially search cells C15 of the opened wb2. Search would be looking for the letters OT. If no OT was found then the Cell B15 would be entered into Cell I5 ofwb1 (.Offset(, 8).Value = wb2.Worksheets(i).Range("B15").MergeArea.Value). If OT was found, the value would be entered into Cell I6 of wb1.

Then it would search Cell B16 etc. until it hits an empty cell at which point it would move on to the next worksheet as it currently does.

I think I can figure out a way to brute force it, but was wondering if there is an elegant solution.

Sub IMPORT_DATA()
Application.ScreenUpdating = False
Application.Calculation = False
    Const FirstRow As Long = 4
    Const InitialFileName = "c:\"
    Dim FileName As String
    FileName = getFileName(InitialFileName)
    If Len(FileName) = 0 Then Exit Sub 'exits sub if no file name is selected
    Dim wb2 As Workbook
    Dim sh As Worksheets
    Dim lr As Long, i As Long
    lr = FirstRow

If Len(FileName) > 0 Then
Set wb2 = Workbooks.Open(FileName)
End If

    For i = 3 To wb2.Worksheets.Count 'Starts workbook search after rate sheets
        lr = lr + 1 'sets start row as 5
        With ThisWorkbook.Worksheets("JOB NUMBER").Range("A" & lr)    '<----- Change as required
            .Value = CStr(wb2.Worksheets(i).Name)
            .Offset(, 1).Value = wb2.Worksheets(i).Range("J61").MergeArea.Value
            .Offset(, 2).Value = wb2.Worksheets(i).Range("J27").MergeArea.Value
            .Offset(, 4).Value = wb2.Worksheets(i).Range("J39").MergeArea.Value
            .Offset(, 6).Value = wb2.Worksheets(i).Range("J50").MergeArea.Value
            .Offset(, 7).Value = wb2.Worksheets(i).Range("J60").MergeArea.Value
        [B].Offset(, 8).Value = wb2.Worksheets(i).Range("B15").MergeArea.Value
            .Offset(, 9).Value = wb2.Worksheets(i).Range("B16").MergeArea.Value
            .Offset(, 10).Value = wb2.Worksheets(i).Range("B17").MergeArea.Value
            .Offset(, 11).Value = wb2.Worksheets(i).Range("B18").MergeArea.Value
            .Offset(, 12).Value = wb2.Worksheets(i).Range("B19").MergeArea.Value
            .Offset(, 13).Value = wb2.Worksheets(i).Range("B20").MergeArea.Value[/B]
            
            End With
    Next i
    wb2.Close False
    Application.ScreenUpdating = True
    Application.Calculation = True
End Sub

Public Function getFileName(Optional InitialFileName As String) As String
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Title = "Select the a File"
        .InitialFileName = InitialFileName
        .Filters.Clear
        .Filters.Add "Excel files", "*.xls*"
        '.Filters.Add "All files", "*.csv"
        '.Filters.Add "All files", "*.*"

        If .Show = -1 Then
           getFileName = .SelectedItems(1)
        End If
        
    End With
End Function

 

[Declanscully]

I am pretty sure I have found the way to brute force it using INSTR and IF statements. Just have to find a way to be able to cycle through it using an FOR statement.

If InStr(wb2.Worksheets(3).Range("C54"), "Hotel") > 0 Then
    ThisWorkbook.Worksheets("ADMIN").Range("E10").Value = wb2.Worksheets(3).Range("J54").MergeArea.Value
        End If

 

[Fluff]

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Copy data based on cell value
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.