Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
IF Clause
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.F ile.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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
IF Clause
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 lStart0 and lEnd0 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" <juergenkemeter.21eepy_1136862001.6525@excelforu m-nospam.com wrote in message news:juergenkemeter.21eepy_1136862001.6525@excelfo rum-nospam.com... 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.F ile.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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
IF Clause
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
IF Clause
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" <juergenkemeter.21et2m_1136880608.8611@excelforu m-nospam.com wrote in message news:juergenkemeter.21et2m_1136880608.8611@excelfo rum-nospam.com... 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
IF Clause
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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
IF Clause
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" <juergenkemeter.21fqem_1136923808.7112@excelforu m-nospam.com wrote in message news:juergenkemeter.21fqem_1136923808.7112@excelfo rum-nospam.com... 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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
IF Clause
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. Code: -------------------- Sub Test_noSpaces_dateiensuchen_und_daten_extrahieren( ) Dim fs As Variant, i As Integer, bla Dim strRange As String, colcount As Integer, colcount2 As Integer Dim cl As Range Set fs = Application.FileSearch Const HEADER_COL As Integer = 2 Dim lStart As Long, lEnd As Long With fs .LookIn = "M:\Development\GeneSheets_DataExtract_Loop\Gene.F ile.Lists" .SearchSubFolders = True .Filename = "*.xls" .Execute For i = 1 To .FoundFiles.count - 1 Workbooks.Open .FoundFiles(i), UpdateLinks:=False 'disable update messages 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 'start row of Data range lEnd = lEnd - 1 'end row of Data range End If ActiveWorkbook.Worksheets("Sequence Data").Range("B" & lStart & ":M" & lEnd).Copy ActiveWorkbook.Close savechanges:=False ActiveSheet.Range("b65536").End(xlUp).Offset(1, 0).Select 'goto next empty cell ActiveSheet.Paste Next i End With Dim cRows As Long Dim u As Long cRows = Cells(Rows.count, "A").End(xlUp).Row For u = cRows To 1 Step -1 If Cells(i, "A").Value = "" Then Range("B" & u, "M" & u).Delete shift:=xlUp End If Next 'Cells.Select 'Range("A800:A2400").SpecialCells(xlCellTypeBlanks ).EntireRow.Delete 'Range("B2:M65000").SpecialCells(xlCellTypeBlanks) .EntireRow.Delete Set fs = Nothing End Sub -------------------- Cheers Juergen -- juergenkemeter ------------------------------------------------------------------------ juergenkemeter's Profile: http://www.excelforum.com/member.php...o&userid=25248 View this thread: http://www.excelforum.com/showthread...hreadid=499619 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
PERCENTILE with an IF Clause | Excel Worksheet Functions | |||
IF Clause | Excel Worksheet Functions | |||
"Between" in an IF clause | Excel Discussion (Misc queries) | |||
if then clause in a cell | Excel Programming | |||
Where Clause Errors | Excel Programming |