PDA

View Full Version : VBA Newbie question



anja
05-08-2018, 02:47 AM
Hi everybody,


could someone maybe rewrite the below VBA-Code :-) ? I´m a newbie in Excel VBA. I would like to use this in Excel 2013, so that the modified code search a range (eg. A1:C20) in all Excel files on a network folder (for ex: m:\Users\Anja\test\ (test file1, test file2, test file3, etc.) and look for 2 words (eg. apple & orange). When this word has been found, the value right to the match (for ex. 12) must be shown as listed below in a blank new Excel File. So, this is how it should looks like :-)


A1 - A2 - A3


Test File 1 - Apple - 12
Test File 1 - orange - 10
Test File 2 - Apple - 8
Test File 2 - orange - 9


Thanks in advance for your support and have a nice day.

Best regards

Anja


Option Explicit


Sub Start()
Dim sPath$, sDir$
Dim arFiles(), arAusgabe(), varSucheNach
Dim n&, nn&
'Filter für suche nach Dateien
Const DateiFilter$ = "*CGN Hub Recap*.xlsx"
'wie die Tabelle heißt in der externen Datei
Const TabellennameinExtern$ = "Recap Summary"


'Ordner wo gesucht werden soll, evtl. anpassen
sPath = ThisWorkbook.Path
sPath = sPath & IIf(Right$(sPath, 1) <> "", "", "")


sDir = Dir$(sPath & DateiFilter, vbNormal)
Do While sDir <> ""
ReDim Preserve arFiles(n)
arFiles(n) = sDir
n = n + 1
sDir = Dir$()
Loop
If n > 0 Then
With Tabelle1
If .UsedRange.Rows.Count > 1 Then
If .UsedRange.Columns.Count > 1 Then
.Range("B2", .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).Clear
End If
End If
n = .Cells(1, .Columns.Count).End(xlToLeft).Column
If n > 1 Then
varSucheNach = .Range("B1", .Cells(2, n))
Else
Exit Sub
End If
End With


ReDim Preserve arAusgabe(1 To UBound(arFiles) + 1, 1 To n + 1)
For n = LBound(arFiles) To UBound(arFiles)
arAusgabe(n + 1, 1) = arFiles(n)
For nn = LBound(varSucheNach, 2) To UBound(varSucheNach, 2)
arAusgabe(n + 1, nn + 1) = ExecuteExcel4Macro("SUMPRODUCT(--('" & sPath & "[" & arFiles(n) & "]" & _
TabellennameinExtern & "'!R1C1:R12C1=""" & varSucheNach(1, nn) & """))")
Next
Next

With Tabelle1
With .Range("A2").Resize(UBound(arAusgabe), UBound(arAusgabe, 2))
.Value = arAusgabe
End With
End With
End If
End Sub