VBA - Condition - look for a certain cell value

[juergenkemeter]

Hi,
My code looks into a folder with several xls files and opens each one of them.
Then it copies a specific range out of a sheet and gatheres it into a new sheet.

Unfortunately the range changes between the xls files.

It would be necessary to look out for the common header string 'Primary Sequences', and then select the range (cols B to M) below this, until the next header 'Derived Sequences' occurs.

If someone knows how to add such a condition to my code, this would be very helpful!

I have enclosed example files.

Sub Test_dateiensuchen_und_daten_extrahieren()
     
    Dim fs As Variant, i As Integer, bla
    Dim strRange As String, colcount As Integer, colcount2 As Integer
    Set fs = Application.FileSearch
     
    colcount = 2
    colcount2 = 5
    
    strRange = "B" & colcount & ":M5"
     
    With fs
        .LookIn = "M:\Development\GeneSheets_DataExtract_Loop\Gene.File.Lists"
        .SearchSubFolders = True 'Unterordner auch durchsuchen
        .Filename = "*.xls" 'alle Excel-Dateien
        .Execute
         
        For i = 1 To .FoundFiles.count - 1
            
            Workbooks.Open .FoundFiles(i), UpdateLinks:=False 'disable message boxes
            bla = ActiveWorkbook.Worksheets("Sequence Data").Range("B6:M9")
            ActiveWorkbook.Close savechanges:=False
            
            Range(strRange) = bla
            colcount = colcount + 4
            colcount2 = colcount2 + 4
            strRange = "B" & colcount & ":M" & colcount2
            'Range("B2:M5").Formula = bla
        Next i
         
    End With
     
     
    Set fs = Nothing
End Sub

Cheers,
Jurgen

[Ecniv]

If the data always starts with a one line gap (or the end, then down key from the title) you can use .find method of the sheet to find the title (hold as a range (rng)).
Then from that range move the rng.toend(xldown).row to find the starting row of data, and rng.toend(xldown).toend(xldown).row to find the last row of data.

Note: The ToEnd is the same as pressing the end key then down froma cell. it only moves until the next break (null) value from filled data, so those break lines have to be empty.

Hope this gives you an idea.

[juergenkemeter]

Hi!

With the following code, I get the error message (translated from german...):
"Run time error 1004 - Application - or object defined fault" in the line

bla = ActiveWorkbook.Worksheets("Sequence Data").Range("B" & lStart & ":M" & lEnd)

The variables lStart and lEnd should contain the actual changing data rows. The actual Data range begins one row after the header, and ends one row before the next header.

Sub Test_dateiensuchen_und_daten_extrahieren()

    Dim fs As Variant, i As Integer, bla
    Dim strRange As String, colcount As Integer, colcount2 As Integer
    Set fs = Application.FileSearch
    
    Const HEADER_COL As Integer = 1
    Dim lStart As Long, lEnd As Long
     
     
    colcount = 2
    colcount2 = 5
    
    strRange = "B" & colcount & ":M5"
     
    With fs
        .LookIn = "C:\Dokumente und Einstellungen\Jürgen\Desktop\Gene.File.Lists"
        .SearchSubFolders = True 'Unterordner auch durchsuchen
        .Filename = "*.xls" 'alle Excel-Dateien
        .Execute
         
        For i = 1 To .FoundFiles.count - 1
            
            Workbooks.Open .FoundFiles(i), UpdateLinks:=False 'disable message boxes
            
            lStart = 0: lEnd = 0

            With ActiveWorkbook.Worksheets("Sequence Data").Columns(HEADER_COL)
                On Error Resume Next
                lStart = .Find("Primary Sequences").Row
                lEnd = .Find("Derived Sequences").Row
                On Error GoTo 0
            End With

            If lStart > 0 And lEnd > 0 Then
                lStart = lStart + 1 'beginning of Data row range
                lEnd = lEnd - 1 'end of Data row range
            End If
            
            bla = ActiveWorkbook.Worksheets("Sequence Data").Range("B" & lStart & ":M" & lEnd)
            
            ActiveWorkbook.Close savechanges:=False
            
            Range(strRange) = bla
            colcount = colcount + 4
            colcount2 = colcount2 + 4
            strRange = "B" & colcount & ":M" & colcount2
            'Range("B2:M5").Formula = bla
        Next i
         
    End With
     
    Set fs = Nothing
End Sub