PDA

View Full Version : Solved: Pattern match to find worksheet name

Glaswegian
06-04-2009, 06:26 AM
Hi again

I'm trying to search through sheet names in a workbook, looking for particular sheets which I'll copy to another workbook. I'm having a bit of a problem with trying to find the sheet names.

Each workbook will have around 20-25 sheets, but I'm only interested in sheet names that match a specific pattern.

The sheets are named as the original sheet name plus the date and time the sheet was saved. In the examples below, x represents any letter and 9 represents any digit. However, the original sheet name could be between 3 and 7 characters.

xxxx 99 xxx 99 - 99.99
xxxxxx 99 xx 99 - 99.99

and so on. After I identify the sheet, I take a copy and do some other stuff.

For Each sht In Workbooks(myFile).Worksheets
If sht.Name Like "[A-Z] ##" Then
sht.Copy After:=Workbooks("DCS July 2009.xls").Sheets(1)
End If
Next sht
It's the pattern I can't get right and I've tried several variations - hopefully someone will put me out my misery here...

Glaswegian
06-04-2009, 06:30 AM
Sorry folks - think I've solved it - this seems to work..

If sht.Name Like "[A-Z]* ## *" Then

mdmackillop
06-04-2009, 06:53 AM
I made this this morning to get sheet names. Might be of use to let you have a quick inspection of any "wrong" names

Sub GetSheets()
Dim Pth As String, FName As String, i As Long, wb As Workbook, ws As Worksheet
Dim mySh As Worksheet

Application.ScreenUpdating = False
Set mySh = ActiveSheet

Pth = "C:\Gill\"
FName = Dir(Pth & "*.*")
Do Until FName = ""
Set wb = Workbooks.Open(Pth & FName)
For Each ws In wb.Sheets
i = i + 1
If ws.UsedRange.Cells.Count > 10 Then
mySh.Cells(i, 1) = wb.Name
mySh.Cells(i, 2) = ws.Name
End If
Next
wb.Close False
FName = Dir
Loop
Application.ScreenUpdating = True
End Sub

For my purpose. I then sorted order to suit and imported into one sheet

Sub ImportData()
Dim uRng As Range
Dim Pth As String
Dim tgt
Dim Sht As Worksheet
Dim i As Long
Dim wb As Workbook
Dim TgtSht As Worksheet
Dim MyBk As Workbook

Application.ScreenUpdating = False
Set MyBk = ActiveWorkbook
Set Sht = MyBk.Sheets("Sheet1")
Set tgt = MyBk.Sheets("Sheet2").Cells(1, 1)
Pth = "C:\Gill\"
For i = 1 To 45
If Sht.Cells(i, 1) <> "" Then
Set wb = Workbooks.Open(Pth & Sht.Cells(i, 1).Text)
wb.Sheets(Sht.Cells(i, 2).Text).UsedRange.Copy tgt
wb.Close False
Set uRng = MyBk.Sheets("Sheet2").UsedRange
Set tgt = uRng.Offset(uRng.Rows.Count + 1)(1)
End If
Next
Application.ScreenUpdating = True
End Sub

Glaswegian
06-04-2009, 07:24 AM
Thanks Malcolm - that's interesting stuff. Now squirrelled away for later use.