PDA

View Full Version : Partial workbook match



geomano
06-07-2017, 05:22 AM
Hi,
I am trying to amend my macro, so it will pick up a file staring with particular name, like for instance "Monthly*". Is there any way to do that in VBA? Many thanks for support.
Here's my macro:


Sub HYandQUpdate()

Dim wb As Workbook
Dim wb2 As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim myPath As String
Dim wbNames
Dim i As Long
Dim myRange As Range

Application.ScreenUpdating = False

myPath = Application.ActiveWorkbook.Path

wbNames = Array("Half Years", "Quarterly")
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Con")
For i = LBound(wbNames) To UBound(wbNames)
Set wb2 = Workbooks.Open(myPath & "\" & wbNames(i) & ".xls")
For Each ws2 In wb2.Worksheets
Set myRange = ws.Range("A:A").Find(what:=ws2.Name, LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows)
If Not myRange Is Nothing Then

ws2.Range("b4").Value = myRange.Value

ws2.Range("b11").Value = myRange.Offset(, 7).Value

ws2.Range("b2").Value = myRange.Offset(, 4).Value & "/" & myRange.Offset(, 5).Value

ws2.Range("b7").Value = myRange.Offset(, 6).Value

ws2.Range("b12").Value = myRange.Offset(, 13).Value
'
ws2.Range("b5").Value = myRange.Offset(, 3).Value

ws2.Range("b10").Value = myRange.Offset(, 12).Value

ws2.Range("b19").Value = myRange.Offset(, 21).Value

End If
Set myRange = Nothing
Next ws2

'wb2.Save
'wb2.Close
Next i
Application.ScreenUpdating = True

End Sub

GTO
06-07-2017, 06:01 AM
Greetings,

Please use code tags when posting code. Press the little "#" button atop the reply window and tack your code in between the tags.

As to your issue, try something like:



Option Explicit

Sub Example()
Const MATCH_NAME As String = "class" '<--change to suit

Dim FSO As Object ' Scripting.FileSystemObject
Dim fsoFile As Object ' Scripting.File
Dim WB2 As Workbook

Set FSO = CreateObject("Scripting.FileSystemObject")

For Each fsoFile In FSO.GetFolder(ThisWorkbook.Path).Files
If LCase$(fsoFile.Name) Like LCase$(MATCH_NAME) & "*.xls*" Then
Application.EnableEvents = False
Set WB2 = Workbooks.Open(Filename:=fsoFile.Path, UpdateLinks:=False, ReadOnly:=True)
Application.EnableEvents = True

MsgBox "Do something with worksheet """ & WB2.Worksheets(1).Name & """.", vbOKOnly, vbNullString

Application.EnableEvents = False
WB2.Saved = True
WB2.Close False
Application.EnableEvents = True
End If
Next

End Sub


Hope that helps,

Mark

geomano
06-07-2017, 11:35 PM
Hi GTO, that's just perfect, thank you so much!

GTO
06-08-2017, 12:57 AM
You are most welcome :)