[RESOLVED] Excel 2003 - Get certain column from all XLS in a directory

[nmadd]

Hi all,

Excuse my completely newbie question but I have virtually no experience with programming Excel. What I'm trying to do is grab addresses from a certain column on a certain sheet from many Excel files in a directory

So my task is:
-Loop through all Excel files in a certain directory.
-Grab the values of cells in a certain column (they are all in the same column) up to a point.
--This would be everything in between the first non-blank cell and the next non-blank cell inclusive: 3-5 lines worth.
--There are no headers. It is an invoice-like sheet.
-Place each value in a specific column in a new workbook.

If I can provide further information just let me know.

Frankly, I don't know where to start. Any push in the right direction is certainly appreciated. Somebody kick this new Excel programmer in the head.

[BillBoeBaggins]

1. Build a list of file names (using file functions which I have not used in years).
2. Load an instance of Excel Dim XL as New Excel.Application
3. Xl.Open to all of your files in your list, make sure that you tell Excel to not ask you if you want to update linked data etc or that will throw you off. It is a property for the XL object.
4. Open a new workbook, set its reference Set Wkb = Xl.Workbooks("thisisme")
5. Cycle through the workbooks
For I = 1 to Xl.Workbooks.Count Then
'select the correct sheet
'test workbook name to make sure your not ripping data from your composite data sheet
'cycle through the rows until your done (test for empty/null)
AddData "Data Ripped from other sheet"
Next I
6. Save your new workbook
7. Close all workbooks

Thats the gist of it. I can elaborate. As I have coded what your looking for except for the building a list of file names from a directory part.

[BillBoeBaggins]

Heres what I have done. Not perfectly matched to what you want.

Private Type RiskItem
    FileN As String
    Name  As String
    Risk As String
    Efficiency As String
    MemberCount As String
End Type

Sub GetRiskData()
    Const StartRow = 10
    Const FirstCheckRow = 3
    Const FirstCheckCol = 5
    Const SecondCheckRow = 6
    Const SecondCheckCol = 9
    Const NameCol = 2
    Const RiskCol = 9
    Const EffCol = 23
    Const MembCol = 11
    Const NoMoreData = 10
    Dim index As Long
    Dim cur_index As Long
    Dim itms() As RiskItem
    Dim itm As RiskItem
    Dim blankcnt As Integer
    Dim wkb As Excel.Workbook
    Dim sht As Excel.Worksheet
    Dim tmpinfo As String
    Dim offset As Long
    index = 1
    'Loop through all Risk Workbooks
    For i = 1 To Excel.Workbooks.Count
        For ii = 1 To Excel.Workbooks(i).Sheets.Count
            Set sht = Excel.Workbooks(i).Worksheets(ii)
            blankcnt = 0
            If (CStr(sht.Cells(FirstCheckRow, FirstCheckCol)) = "Efficiency Summary") And _
                    (CStr(sht.Cells(SecondCheckRow, SecondCheckCol)) = "Relative Risk") Then
                cur_index = StartRow    'Reset to first data row
                tmpinfo = Excel.Workbooks(i).Name   'Use workbook name to determine
                                                    'LOB/Client/Spec
                offset = 0
                Do
                    If (Len(sht.Cells(cur_index + offset, NameCol)) <= 0) Then
                        blankcnt = blankcnt + 1
                        If blankcnt >= NoMoreData Then
                            Exit Do
                        End If
                    Else
                        blankcnt = 0
                        ReDim Preserve itms(index)
                        With itms(index - 1)
                            .FileN = tmpinfo
                            .Name = sht.Cells(cur_index + offset, NameCol)
                            .Risk = sht.Cells(cur_index + offset, RiskCol)
                            .Efficiency = sht.Cells(cur_index + offset, EffCol)
                            .MemberCount = sht.Cells(cur_index + offset, MembCol)
                        End With
                        index = index + 1
                    End If
                    offset = offset + 1
                Loop
            End If
        Next ii
    Next i

'Dump Data into Spreadsheet
    Excel.Workbooks.Add
    Set wkb = Excel.ActiveWorkbook
    Set sht = Excel.ActiveSheet
    sht.Cells(1, 1) = "File Name"
    sht.Cells(1, 2) = "Name"
    sht.Cells(1, 3) = "Risk"
    sht.Cells(1, 4) = "Efficiency"
    sht.Cells(1, 5) = "Member Count"
    For l = 0 To index - 1
        sht.Cells(l + 2, 1) = itms(l).FileN
        sht.Cells(l + 2, 2) = itms(l).Name
        sht.Cells(l + 2, 3) = itms(l).Risk
        sht.Cells(l + 2, 4) = itms(l).Efficiency
        sht.Cells(l + 2, 5) = itms(l).MemberCount
    Next l
Cleanup:
    Set wkb = Nothing
    Set sht = Nothing
    MsgBox "Done"
End Sub

[nmadd]

Thanks for the quick reply! I'm going to digest this and I'm sure I'll be back with some questions.

[nmadd]

So here is what I ended up doing. This is probably ugly and I'm certain many improvements can be made but until I get a chance to play around with the Excel object a bit more, this will do.

The one question I did have is why can't I get to the cell's Value, Text or any properties for that matter when I use Cell(1,1) however I can when I use Range("A1")?

Thanks again for the push in the right direction.

Imports System.IO
Imports Microsoft.Office.Interop.Excel
 
Module Module1
 
    Sub Main()
 
        Console.WriteLine("Working...")
 
        Dim di As New DirectoryInfo("\\path\to\files")
        Dim fi() As FileInfo = di.GetFiles()
 
        Dim app As New Application()
        app.Visible = False
 
        Dim fromWb As Workbook = Nothing
        Dim toWb As Workbook = app.Workbooks.Open("C:\Addresses.xls")
        Dim fromSheet As Worksheet = Nothing
        Dim toSheet As Worksheet = Nothing
 
        Dim record As Integer = 1
 
        For Each f As FileInfo In fi
            fromWb = app.Workbooks.Open(f.FullName, UpdateLinks:=False)
 
            If SheetExists("royalty detail", fromWb) Then
                Dim firstData As Integer = 5
 
                fromSheet = CType(fromWb.Worksheets("royalty detail"), Worksheet)
                toSheet = CType(toWb.Worksheets("Main"), Worksheet)
 
                Do Until fromSheet.Range("C" & firstData).Text.ToString().Trim().Length > 0
                    firstData += 1
                Loop
 
                toSheet.Cells(record, 1) = fromSheet.Cells(firstData, 3)
                toSheet.Cells(record, 2) = fromSheet.Cells(firstData + 1, 3)
                toSheet.Cells(record, 3) = fromSheet.Cells(firstData + 2, 3)
                toSheet.Cells(record, 4) = fromSheet.Cells(firstData + 3, 3)
                toSheet.Cells(record, 5) = fromSheet.Cells(firstData + 4, 3)
 
                record += 1
            End If
 
            fromWb.Close(SaveChanges:=False)
        Next f
 
        toWb.Close(SaveChanges:=True)
 
        Console.WriteLine("Complete.")
 
    End Sub
 
    Private Function SheetExists(ByVal sheet As String, ByVal wb As Workbook) As Boolean
 
        For Each sht As Worksheet In wb.Worksheets
            If sht.Name = sheet Then
                Return True
            End If
        Next sht
 
        Return False
 
    End Function
 
End Module

[BillBoeBaggins]

Yours is far more nice to look at then mine haha

So your saying your fromSheet.Cells(firstData + 4, 3) returns nothing though there should be a value?

The reason you get more options I am guestimating from the Range, is simply the object model support. The Cells references is probably a quick and dirty, and the Range exposes all properties. My thoughts.

[nmadd]

It does return a value and the code works as expected.
I'm saying that I had to do this

Do Until fromSheet.Range("C" & firstData).Text.ToString().Trim().Length > 0

because this

Do Until fromSheet.Cells(firstData, 3).Text.ToString().Trim().Length > 0

doesn't work. I can't get to any of the cells properties using Cells in place of Range.

Just curious.

[BillBoeBaggins]

Shouldn't it be "Do While" instead of "Do Until"?

I probably would of did..

Do While Len(Trim((sht.Cells(3,3))))>0

[nmadd]

It's "Until" for my purpose. I was looking in the column for the first cell that had something in it. I was trying to get a reference to the first cell that contained some data.