VBA: Using Dir depending on a cell value

[zedordead]

Hi there, first post so sorry if I've broken any rules (I have searched this everywhere though).

I have several thound excel forms in a directory that fall into two (very similar) formats, and have written some code to pull cell D38 back into my summary sheet.

The problem I have is the difference between the two formats. If Cell C1 is populated with text then I need to pull back cell D38, if Cell D1 is populated with text then I need to pull back cell C20.

Any suggestions on how to do this?

Option Explicit
Sub fileinfo()
Dim myDir As String, fn As String, sn As String, sn2 As String, n As Long, NR As Long, ver As String
'***** Change Folder Path *****
myDir = "C:\Documents and Settings\test" 'for testing
'***** Change Sheetname(s) *****
sn = "PS1012 Assessment Matrix"
fn = Dir(myDir & "\*.xls")
Do While fn <> ""
  If fn <> ThisWorkbook.Name Then
   With ThisWorkbook.Sheets("Summary")
        NR = .Cells(Rows.Count, 1).End(xlUp).Row + 1
               With .Range("A" & NR)
                    .Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!D38"
                    .Value = .Value
                    End With
            
    End With
  End If
  fn = Dir
Loop
End Sub

 

[Philosophaie]

Do While fn <> ""
  If fn <> ThisWorkbook.Name Then
   With ThisWorkbook.Sheets("Summary")
        NR = .Cells(Rows.Count, 1).End(xlUp).Row + 1
               With .Range("A" & NR)
                    .Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!D38"
                    .Value = .Value
                End With
    End With
  End If

Not sure what you want. Maybe all another Column of data?

If not .Range("C1") = "" then
With .Range("A" & NR)
.Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!D38"
.Value = .Value
End With
End If
If not .Range("D1")="" then
With .Range("B" & NR)
.Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!C20"
.Value = .Value
End With
End If

 

[zedordead]

Sorry maybe not clear enough! My code at the moment lifts cell D38 from every form in the test directory. I want the code to either lift cell D38 or C20 depending on C1 or D1. And as I am not opeing the workbook (for sake of efficiency) I can't use .Range, right?

I tried something like what you have provided, and it seems to open the first xls file in the directory and then, depending on whether C1 or D1 are populated in THAT file use that for all the files.

Thanks

 

[zedordead]

So if I have 50 XLs in format 1 (with something in C1) and 50 XLs in format 2 (with something in cell D1), I would want a report with all 100 values, 50 being from the D38 cells and 50 being from the C20 cells.

Thanks

 

[Philosophaie]

You have to open the workbook to access the data. Either you open the file from your application (hit the open button) then access the application, the sheet and the data you want. Or you can access it using ActiveX which you also have to open the file visible or not.

Dim XLApp, XLBook As Object
    Set XLApp = CreateObject("Excel.Application")
    Path = "C:\Users\User1\Documents\"
    File = "Excel file.xls"
    Set XLBook = XLApp.Workbooks.Open(Path & File)
    XLBook.Activate
    XLApp.Run ("Sheet1.CommandButton1_Click")
    XLApp.Visible = False
 
...Put data here...
               With XLApp.XLBook.Range("A" & NR)
                    .Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!D38"
                    .Value = .Value
                End With
...
    XLBook.Close savechanges:=False
    XLApp.Quit
    Set XLBook = Nothing
    Set XLApp = Nothing

 

[zedordead]

OK found a solution that looks like so:

Option Explicit
Sub PS1012()
Dim myDir As String, fn As String, sn As String, sn2 As String, n As Long, NR As Long, ver As String
'***** Change Folder Path *****
myDir = "C:\Documents and Settings\test" 'for testing
'***** Change Sheetname(s) *****
sn = "Matrix"
fn = Dir(myDir & "\*.xls")
Do While fn <> ""
  If fn <> ThisWorkbook.Name Then
   With ThisWorkbook.Sheets("Summary")
        NR = .Cells(Rows.Count, 1).End(xlUp).Row + 1
 
            ver = "'" & myDir & "\[" & fn & "]" & sn & "'!" & _
                Range("D1").Range("A1").Address(, , xlR1C1)
            ver = ExecuteExcel4Macro(ver)
            If not ver = "" Then
                With .Range("A" & NR)
                    .Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!C20"
                    .Value = .Value
                End With
            Else
                With .Range("A" & NR)
                    .Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!D38"
                    .Value = .Value
                End With
            End If
    End With
  End If
  fn = Dir
Loop
End Sub

Thanks for the help

 

[zedordead]

OK, now that I've got that, I would like to be able to take a range of cells instead of just C20 or D38.

Ideally I would like to bring back cells C1:C20 into row A in my report. Is that possible without typing out all the cells individually?

Thanks