JasonPurdueEE
Technical User
Ok, heres what I need to do: I have some code (big thanks to rmikesmith!) that looks through a list of files and pulls out values in certain cells. I need to add something to it to look at values in the range F12:F28 of each file and if a value (a string) is present then I need it to be written in a cell on the same sheet as the other values (but on the same row, just a different column). Heres the code I got from rmikesmith:
Option Explicit
Sub GetFiles()
Dim wks As Worksheet
Dim wkb As Workbook
Dim C As Range
Dim FName As String
Dim RetStr As String
Dim DataEntryRow As Long
Dim LastFNameRow As Long
Application.ScreenUpdating = False
Set wks = ThisWorkbook.Worksheets("Sheet1"
DataEntryRow = wks.Cells(65536, 4).End(xlUp).Row
If IsEmpty(wks.Cells(1, 4)) Then DataEntryRow = 0
LastFNameRow = wks.Cells(65536, 1).End(xlUp).Row
If IsEmpty(wks.Cells(2, 1)) Then
MsgBox "No Files To Open", vbExclamation + vbOKOnly, "Get Files"
Exit Sub
End If
For Each C In wks.Range(Cells(1, 1), Cells(LastFNameRow, 1))
FName = C.Value
RetStr = Dir(FName, vbNormal)
If RetStr <> "" Then
'Perform operations on file
Set wkb = Workbooks.Open(FName)
DataEntryRow = DataEntryRow + 1
wks.Cells(DataEntryRow, 2) = wkb.ActiveSheet.Range("E4".Value
wkb.Close
Else
MsgBox "Could not find file " & FName, vbExclamation + vbOKOnly, "Open File"
End If
Next C
Application.ScreenUpdating = True
End Sub
If you need additional clarification, please let me know. Thank you for your help. Any tips or hints are greatly appriciated.
Option Explicit
Sub GetFiles()
Dim wks As Worksheet
Dim wkb As Workbook
Dim C As Range
Dim FName As String
Dim RetStr As String
Dim DataEntryRow As Long
Dim LastFNameRow As Long
Application.ScreenUpdating = False
Set wks = ThisWorkbook.Worksheets("Sheet1"
DataEntryRow = wks.Cells(65536, 4).End(xlUp).Row
If IsEmpty(wks.Cells(1, 4)) Then DataEntryRow = 0
LastFNameRow = wks.Cells(65536, 1).End(xlUp).Row
If IsEmpty(wks.Cells(2, 1)) Then
MsgBox "No Files To Open", vbExclamation + vbOKOnly, "Get Files"
Exit Sub
End If
For Each C In wks.Range(Cells(1, 1), Cells(LastFNameRow, 1))
FName = C.Value
RetStr = Dir(FName, vbNormal)
If RetStr <> "" Then
'Perform operations on file
Set wkb = Workbooks.Open(FName)
DataEntryRow = DataEntryRow + 1
wks.Cells(DataEntryRow, 2) = wkb.ActiveSheet.Range("E4".Value
wkb.Close
Else
MsgBox "Could not find file " & FName, vbExclamation + vbOKOnly, "Open File"
End If
Next C
Application.ScreenUpdating = True
End Sub
If you need additional clarification, please let me know. Thank you for your help. Any tips or hints are greatly appriciated.