IF Clause

[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.

Please Login or Register  to view this content.

Cheers,
Jurgen

[Tim Williams]

In which column(s) do the headers occur? Is there always only one set of
headers per file?

I would use .Find on the column containing the headers to get the relevant
start and end rows

Eg something like (untested):

'#######################
const HEADER_COL as integer=1
Dim lStart as long, lEnd as long


lStart=0:lEnd=0

with ActiveWorkbook.Worksheets("Sequence Data").columns(HEADER_COL)
on error resume next
set lStart = .Find("Primary Sequences").row
set lEnd = .Find("Primary Sequences").row
on error goto 0
end with

if lStart>0 and lEnd>0 then
'....calculate range to copy
end if
'######################

You might have to adjust the parameters to .Find() if you need to locate
cells based on partial content.
Try this out and post back if further questions.

Tim.

"juergenkemeter"
<[email protected]> wrote in
message news:[email protected]...
>
> 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.
>
>
>
> Code:
> --------------------
>
> 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
>
>
> +-------------------------------------------------------------------+
> |Filename: GeneSheets_DataExtract_Loop.zip |
> |Download: http://www.excelforum.com/attachment.php?postid=4197 |
> +-------------------------------------------------------------------+
>
> --
> juergenkemeter
> ------------------------------------------------------------------------
> juergenkemeter's Profile:
> http://www.excelforum.com/member.php...o&userid=25248
> View this thread: http://www.excelforum.com/showthread...hreadid=499619
>

[juergenkemeter]

Hi!

The headers can be found in column B.
The beginning header is 'Primary Sequences', the end header is 'Derived Sequences' - as you can see in my enclosed example files.

Here is the code I tried, but I get the following error message:
"Compilation fault: Object necessary", and pointing to the line which contains
Set lStart = .Find("Primary Sequences").Row

Please Login or Register  to view this content.

[Tim Williams]

Sorry, my error. Remove the "Set" from both those lines.

lStart = .Find("Primary Sequences").Row
lEnd = .Find("Derived Sequences").Row

Tim.

--
Tim Williams
Palo Alto, CA


"juergenkemeter"
<[email protected]> wrote in
message news:[email protected]...
>
> Hi!
>
> The headers can be found in column B.
> The beginning header is 'Primary Sequences', the end header is 'Derived
> Sequences' - as you can see in my enclosed example files.
>
> Here is the code I tried, but I get the following error message:
> "Compilation fault: Object necessary", and pointing to the line which
> contains
> Set lStart = .Find("Primary Sequences").Row
>
>
>
> Code:
> --------------------
>
> 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
> Set lStart = .Find("Primary Sequences").Row
> Set lEnd = .Find("Derived Sequences").Row
> On Error GoTo 0
> End With
>
> If lStart > 0 And lEnd > 0 Then
>
>
> '....calculate range to copy
> End If
>
> bla = ActiveWorkbook.Worksheets("Sequence Data").Range("B" & lStart + 1
& ":M" & lEnd - 1)
>
> 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
>
> --------------------
>
>
> --
> juergenkemeter
> ------------------------------------------------------------------------
> juergenkemeter's Profile:
http://www.excelforum.com/member.php...o&userid=25248
> View this thread: http://www.excelforum.com/showthread...hreadid=499619
>

[juergenkemeter]

I removed the two settings.
I also changed the variables lStart and lEnd, as the actual Data range begins one row after the header, and ends one row before the next header.

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)

Please Login or Register  to view this content.

[Tim Williams]

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

What are you trying to do with this line? Right now it's trying to assign a
range *object* to bla (in this case you would need a "Set"), so maybe you
wanted to assign the *value* of the range to bla (giving you a 2-D array of
data in bla)?

The easiest thing to do is just to copy the range *before* closing the file.
Eg:
ActiveWorkbook.Worksheets("Sequence Data").Range("B" & lStart &":M" &
lEnd).copy _
thisworkbook.sheets("destination").Cells(10,3)

You'd have to work out the appropriate values to replace the (10,3).

As a side note you should always qualify your Ranges to include the workbook
Eg: not just
Range("A1")
but
ThisWorkbook.Range("A1")

Tim

--
Tim Williams
Palo Alto, CA


"juergenkemeter"
<[email protected]> wrote in
message news:[email protected]...
>
> I removed the two settings.
> I also changed the variables lStart and lEnd, as the actual Data range
> begins one row after the header, and ends one row before the next
> header.
>
> 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)
>
>
> Code:
> --------------------
>
> 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
>
> --------------------
>
>
> --
> juergenkemeter
> ------------------------------------------------------------------------
> juergenkemeter's Profile:
http://www.excelforum.com/member.php...o&userid=25248
> View this thread: http://www.excelforum.com/showthread...hreadid=499619
>

[juergenkemeter]

Hi Tim,

the following code works now, thanks for your help.
Right now, I am working on how to remove all blank rows in the Destination Sheet, and shift the next row up.

Please Login or Register  to view this content.

Cheers
Juergen