I have managed to develop this code slowly into something that is usable but isn't quite there yet. I am new to VBA and the code below so far does the following:
- Loops through workbooks in a folder
- Copies certain cells from each workbook
- Pastes those cells into rows with information organised by column
- Copies a range from each workbook
Pastes the range (14 rows of data) beside the single rows of data formed by the single cells from each workbook (effectively creating two halves to a worksheet - one half with each single row of data belonging to a certain workbook (Columns A:E) and the other half with each range of 14 rows belonging to a certain workbook (Columns F:M))
All of the above is only carried out if the workbook in the folder has NOT already been looped (this is done via a function)
- This function looks at a column of filenames that is created by previously running the code - meaning that the filename of each looped workbook is recorded in the list created by the code and the code only copies data from workbooks with a filename that is not already included in the list.
The next development of the code that I have been working on and I need help with is adding another condition - I.e making the code only look at files that have not been looped previously AND also only at files with a certain filename-ending, within the group of not looped workbooks.
My logic in how to achieve this was to add another function just like the looped function and modify the code within it to look at the first three characters of a name that is entered in a cell and find/compare it to the not already looped filenames (the filename-ending (its last 3 characters) is always the first three characters of a name).
This is the main code and function:
Sub CopyFromFolderExample()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(1)
Dim strFolder As String, strFile As String, r As Long, wb As Workbook
Dim varTemp(1 To 5) As Variant, r1 As Long, r3 As Range
Application.ScreenUpdating = False
strFolder = "D:\Other\folder\"
strFile = Dir(strFolder & "*.xl*")
Do While Len(strFile) > 0
If Not Looped(strFile, ws) Then
Application.StatusBar = "Reading data from " & strFile & "..."
Set wb = Workbooks.Add(strFolder & strFile)
With wb.Worksheets(1)
varTemp(1) = strFile
varTemp(2) = .Range("A13").Value
varTemp(3) = .Range("H8").Value
varTemp(4) = .Range("H9").Value
varTemp(5) = .Range("H37").Value
Set r3 = .Range("A20:H33")
End With
With ws
r = .Range("A" & .Rows.Count).End(xlUp).Row + 1
r1 = .Range("F" & .Rows.Count).End(xlUp).Row + 1 'last used row in col F
.Range(.Cells(r, 1), .Cells(r, 5)).Value = varTemp
.Cells(r1, 6).Resize(r3.Rows.Count, r3.Columns.Count).Value = r3.Value 'transfer A20:H33
End With
wb.Close False
End If
strFile = Dir
Loop
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub
Private Function Looped(strFile As String, ws As Worksheet) As Boolean
Dim Found As Range
Set Found = ws.Range("A:A").Find(strFile)
If Found Is Nothing Then
Looped = False
Else
Looped = True
End If
End Function
This is the modified function that I have been trying to use by adding another IFstatement into the code - unsuccessfully:
Private Function notx(strFile As String, ws As Worksheet) As Boolean
Dim Found As Range
Set Found = strFile.Find(Left(ws.Range("P1").Value, 3))
If Found Is Nothing Then
notx = False
Else
notx = True
End If
End Function
strFileis a string and you cannot use.Findin a string. TryInStr. Basically changeSet Found = strFile.Find(Left(ws.Range("P1").Value, 3))to someting likeDim Found As Integer Found = InStr(1, strFile, Left(ws.Range("P1").Value, 3))notxfunction.Private Function notx(strFile As String, ws As Worksheet) As Boolean Dim Found As Integer Found = InStr(1, strFile, Left(ws.Range("P1").Value, 3)) If Found = 0 Then notx = False Else notx = True End If End Function