Reputation: 2068
I need to create an Excel VBA Macro that is able to Loop through some Files and if it finds the given String it should fill the Excel Worksheet where I need to.
Currently it looks like this: I show a UserForm that has a TextBox where the String gets entered and a Button.
If the User clicks on that Button then the files should get looped through and if it finds the string in one of that files it should enter something new to the excel where the macro is called from.
I have searched on SO but with no Luck, I found this:
Sub LoopThroughFiles()
Dim StrFile As String
StrFile = Dir("C:\Users\xxx\xxx\xxx\test\*test*")
Do While Len(StrFile) > 0
Debug.Print StrFile
StrFile = Dir
Loop
End Sub
But this looks like it loops and looks if the filename has test in it and not if the actual file has a Value that is called "test".
Also the string that needs to be found is always in the first column of the files. And I would have to read the second column in that activeCell that I would get if the String is found and add that to the Excel where I call this Macro from.
Sincerly Faded ~
Edit:
Sub ReadDataFromAnotherWorkBook()
' Open Workbook A with specific location
Dim src As Workbook
Set src = Workbooks.Open("C:\Users\xxx\Desktop\xxx\test\x1x.xlsx", True, True)
Dim valueBookA As String
Dim valueBookB As Integer
valueBookA = src.Worksheets("Tabelle1").Cells(2, 1) ' Works but here I need to put the enteredValue and search for it
Cells(1, 1).Value = valueBookA
' Close Workbooks A
src.Close False
Set src = Nothing
' Dialog Answer
MsgBox valueBookA
End Sub
This gives me a Value from the read Excel which is good as a first start. I need to loop that to open up more files and also I need the part where I can search for the given String and get the value in that row.
Edit2:
This is what I have now but I cant get the value.. what am I doing wrong :/
Sub ReadDataFromAnotherWorkBook()
Dim SearchString As String
Dim SearchRange As Range, cl As Range
Dim FirstFound As String
Dim sh As Worksheet
' Open Workbook A with specific location
Dim src As Workbook
Set src = Workbooks.Open("C:\Users\x\Desktop\xxx\test\xxx.xlsx", True, True)
' Set Search value
SearchString = TextBox1.Value ' TEST mit TextBox Value -- works
Application.FindFormat.Clear
' loop through all sheets
For Each sh In src.Worksheets
' Find first instance on sheet
Set cl = sh.Cells.Find(What:=SearchString, _
After:=sh.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not cl Is Nothing Then
' if found, remember location
FirstFound = cl.Address
MsgBox FirstFound
' format found cell
Do
' cl.Font.Bold = True
' cl.Interior.ColorIndex = 3
Debug.Print FirstFound
MsgBox FirstFound ' Does not work..
' Debug.Print cl.Value
MsgBox cl.Value ' Also does not work -- I need the VALUE that is in the Excel Row or Column where the string gets found
' find next instance
Set cl = sh.Cells.FindNext(After:=cl)
' repeat until back where we started
Loop Until FirstFound = cl.Address
End If
Next
MsgBox "Value in Excel? : " + FirstFound 'cl.Value > Is empty..
MsgBox "SEARCHSTRING :: " + SearchString ' Gives me the right String
' Close Workbooks A ' Closes the Workbook
src.Close False
Set src = Nothing
End Sub
Upvotes: 0
Views: 863
Reputation: 16357
Use Dir to loop over the files in turn
Sub SearchFiles()
Const FOLDER = "C:\Users\xxx\Desktop\xxx\test\"
Dim wb As Workbook, wbSrc As Workbook
Dim ws As Worksheet, wsSrc As Worksheet
Dim sText As String, sFilename As String
Dim cell As Range, rng As Range
Dim n As Long, i As Long, FirstFound As String
sText = TextBox1.Value
' location of search results
Set wb = ThisWorkbook
Set ws = wb.Sheets(1) ' results of search
ws.Cells.Clear
ws.Range("A1:B1") = Array("Search Test = ", sText)
ws.Range("A2:C2") = Array("Address", "Col A", "Col B")
ws.Range("A2:C2").Font.Bold = True
i = 3
' scan all xlsx files in folder
sFilename = Dir(FOLDER & "*.xlsx")
Do While Len(sFilename) > 0
Set wbSrc = Workbooks.Open(FOLDER & sFilename, True, True)
For Each wsSrc In wbSrc.Sheets
n = n + 1
Set rng = wsSrc.Columns(1)
Set cell = rng.Find(What:=sText, _
After:=rng.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
' text found
If Not cell Is Nothing Then
FirstFound = cell.Address
Do ' update sheet
ws.Cells(i, 1) = cell.Address(0, 0, xlA1, True)
ws.Cells(i, 2) = cell
ws.Cells(i, 3) = cell.Offset(0, 1)
i = i + 1
Set cell = rng.FindNext(After:=cell)
' repeat until back where we started
Loop Until FirstFound = cell.Address
End If
Next
wbSrc.Close
sFilename = Dir
Loop
MsgBox n & " sheets scanned", vbInformation
End Sub
Upvotes: 1