Re: "IF the row has values, do..."
The code shown is part of a function, which openes workbooks in a folder, processes out different data sections (as working like this code example), and then closes the workbook without saving. The filename in column N is therefore no problem.
If interested, I can post the whole function for better understanding - perhaps you can make a comment to my code, as I consider myself not as an advanced programmer?
Ah well - here it is (comments still have to be improved):
Option Explicit
Sub Sequence_Analysis()
'no message display
Application.DisplayAlerts = False
'----------------------------------------------------------------------------------------------------------------
'create variables
'----------------------------------------------------------------------------------------------------------------
Dim fs As Variant, i As Integer, bla
Dim lStart As Long, lEnd As Long
Dim y As Long, gene As Variant
Dim GeneFile As Workbook, MasterFile As Workbook
Const HEADER_COL As Integer = 2
'----------------------------------------------------------------------------------------------------------------
'delete previous worksheets to avoid error message while creating new worksheets
'----------------------------------------------------------------------------------------------------------------
With ActiveWorkbook
On Error Resume Next
.Sheets("Sequence_Analysis_Alignments").Delete
On Error GoTo 0
End With
'----------------------------------------------------------------------------------------------------------------
'Add new destination worksheets for importing and sorting data from gene workbooks
'----------------------------------------------------------------------------------------------------------------
ActiveWorkbook.Sheets.Add.Name = "Sequence_Analysis_Alignments"
'----------------------------------------------------------------------------------------------------------------
'create specific column headers in destination worksheets
'----------------------------------------------------------------------------------------------------------------
Sheets("Sequence_Analysis_Alignments").Select
Range("A1").Select
ActiveCell.FormulaR1C1 = "Comparison"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Species"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Components"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Length"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Source"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Program"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Result"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Name"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Date"
Range("J1").Select
ActiveCell.FormulaR1C1 = "Filename"
Rows("1:1").Select
Selection.Font.Bold = True
'Delete standard worksheets which are of no use
'Sheets("Sheet1").Select
'ActiveWindow.SelectedSheets.Delete
'Sheets("Sheet2").Select
'ActiveWindow.SelectedSheets.Delete
'Sheets("Sheet3").Select
'ActiveWindow.SelectedSheets.Delete
'------------------------------------------------------------------------------------------
'Export gene data - Worksheets "Sequence Analysis"
'------------------------------------------------------------------------------------------
'open each .xls file in folder seperately
Set fs = Application.FileSearch
With fs
.LookIn = "M:\Development\GeneSheets_DataExtract_Loop\Gene.File.Lists" 'location folder of gene files
.SearchSubFolders = True
.Filename = "*.xls"
.Execute
For i = 1 To .FoundFiles.Count 'how many gene files are in the folder?
Set MasterFile = ActiveWorkbook 'for referencing
Workbooks.Open .FoundFiles(i), UpdateLinks:=False 'open gene workbook, disable update messages
lStart = 0: lEnd = 0 'initiate variables
Set GeneFile = ActiveWorkbook 'for referencing
'----------------------------------------------------------------------------------------------------------------
'Alignments section
'----------------------------------------------------------------------------------------------------------------
'search for section headers - data to export is between
With GeneFile.Worksheets("Sequence Analysis").Columns(HEADER_COL)
On Error Resume Next
lStart = .Find("Alignments").Row 'first header
lEnd = .Find("Splice Variants").Row 'second section header
On Error GoTo 0
End With
'take correct start and end rows for data selection
If lStart > 0 And lEnd > 0 Then
lStart = lStart + 2 'data section begins two rows after first header (not 1 because of additional header line)
lEnd = lEnd - 1 'data section ends before second header
End If
'Add column with gene filename
For y = lStart To lEnd
'if there are values in current row
If Application.WorksheetFunction.CountA(GeneFile.Worksheets("Sequence Analysis").Rows(y)) > 0 Then
'write filename into empty column next to data range
GeneFile.Worksheets("Sequence Analysis").Range("K" & y).Value = GeneFile.Name
Else 'do nothing
End If
Next y
GeneFile.Worksheets("Sequence Analysis").Range("B" & lStart & ":K" & lEnd).Copy 'copy Gene Data section
MasterFile.Sheets("Sequence_Analysis_Alignments").Activate 'Change Focus to MasterFile
'set offset for pasting gene data to avoid overwriting existant data in MasterFile
ActiveSheet.Range("J65536").End(xlUp).Offset(1, -9).Select
ActiveSheet.Paste 'paste data section into MasterFile
Range("A1").Select 'Set Focus on first row, for better viewing afterwards
GeneFile.Close savechanges:=False 'close actual gene file workbook
Next i 'open next gene workbook to process Sheet data
End With
Set fs = Nothing
'------------------------------------------------------------------------------------------
'Code to delete all empty rows in new data Sheets
'------------------------------------------------------------------------------------------
Dim WB As Workbook
Dim SH As Worksheet
Dim LastRow As Long
Dim FirstRow As Long
Dim iRow As Long
Set WB = ActiveWorkbook
'delete empty rows in "Sequence Analysis_Alignments"
'set it up to point at the correct workbook/worksheet
Set SH = WB.Sheets("Sequence_Analysis_Alignments")
With SH
'lastrow is the same as the row number for the cell you go
'to when you hit ctrl-end manually.
LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
'just a stopping point.
'if you had a bunch of headers (some empty rows), you
'could ignore them by changing this to a larger number
FirstRow = 1
'start at the lastrow and go up the rows (step -1 is up)
For iRow = LastRow To FirstRow Step -1
'if you see anything (formulas or values in that row)
'then =counta() will be > 0
If Application.CountA(.Rows(iRow)) = 0 Then
'but if it no cells are filled in, then
'delete that row
.Rows(iRow).Delete
End If
Next iRow
End With
Application.DisplayAlerts = True
End Sub
Display More
