Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Hopefully simple Excel VBA question

Status
Not open for further replies.

JasonPurdueEE

Technical User
May 21, 2002
131
US
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 <> &quot;&quot; Then
'Perform operations on file
Set wkb = Workbooks.Open(FName)
DataEntryRow = DataEntryRow + 1
wks.Cells(DataEntryRow, 2) = wkb.ActiveSheet.Range(&quot;E4&quot;).Value

wkb.Close
Else
MsgBox &quot;Could not find file &quot; & FName, vbExclamation + vbOKOnly, &quot;Open File&quot;
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.
 
Hi JasonPurdueEE,

In your sub, call this subroutine with a string value argument and an integer column number argument. It assumes that the active sheet is the one you want to lookup sValue and if found one or more times, put sValue in column iCol in the corresponding row...
Code:
Sub TestValues(sValue As String, iCol As Integer)
    Dim rng As Range, r As Range
    
    Set rng = ActiveSheet.Range(&quot;F12:F28&quot;)
    
    For Each r In rng
        With r
            If .Value = sValue Then
                Cells(.Row, iCol).Value = .Value
            End If
        End With
    Next
End Sub
Skip,
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top