VBA loop with wildcard in Sheet name

Pdunne

New Member
Joined
Aug 29, 2019
Messages
5
Hi All,

I'm pretty new to VBA, this is my also my first time posting on here. Hoping somebody can help me tweak my code;
The code loops through all the files in a folder to copy data from a sheet called ("P&L 2019 - UK GAAP") into one workbook.
The issue that I'm having is that, a couple of the workbooks have not named the sheet ("P&L 2019 - UK GAAP")......

The sheet name will start with P&L so I'm looking for some kind of wildcard, or partial match lookup...
But there is another sheet called "P&L 2019 - US GAAP" withing the workbook, which I want to avoid picking up.

Any help on this would be great!


Sub Template_Consol()


Dim myfile As String
Dim q As Long
q = 1
Dim filepath As String
Dim noWbs As Byte


'This picks up the number of workbooks from the input cell
noWbs = Sheets("inputs for Macro").Range("b3")


'Pick filepath from cell B3 in tab called "Inputs for Macro"
filepath = Sheets("Inputs for Macro").Range("b2")


'Add backslash to the end of the filepath name so that we have the correct syntax in order to concatenate the file name onto the end of this
If Right(filepath, 1) <> "" Then filepath = filepath & ""


Application.ScreenUpdating = False
myfile = Dir(filepath)
Do While Len(myfile) > 0
Workbooks.Open (filepath & myfile)


'Update Sheet name if I want to pull form another sheet
Worksheets("P&L 2019 - UK GAAP").Activate
ActiveSheet.UsedRange.Copy
ActiveWorkbook.Close Save = False


'This should stop excel from asking me about large amount of data on clipboard
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False


Sheets(q).Select
ActiveSheet.Paste Destination:=Worksheets(q).Range("A1")
Application.CutCopyMode = False
q = q + 1


'Number of files is pulled from the input sheet in this workbook


If q > noWbs + 1 Then
Exit Sub
End If
myfile = Dir
Loop
ActiveWorkbook.Save
Application.ScreenUpdating = True




End Sub
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Try this

Code:
Sub Template_Consol()
  Dim myfile As String, q As Long, filepath As String, noWbs As Byte, wb As Workbook, sh As Worksheet
  '
  Application.ScreenUpdating = False
  Application.AskToUpdateLinks = False
  Application.DisplayAlerts = False
  '
  q = 1
  noWbs = Sheets("inputs for Macro").Range("b3")              'This picks up the number of workbooks from the input cell
  filepath = Sheets("Inputs for Macro").Range("b2")           'Pick filepath from cell B3
  If Right(filepath, 1) <> "\" Then filepath = filepath & "\" 'Add backslash to the end of the filepath
  myfile = Dir(filepath)
  Do While Len(myfile) > 0
    Set wb = Workbooks.Open(filepath & myfile)
    For Each sh In wb.Sheets
[COLOR=#0000ff]      If UCase(Left(sh.Name, 3)) = UCase("P&L") Then          'The sheet name will start with P&L[/COLOR]
        sh.UsedRange.Copy ThisWorkbook.Sheets(q).Range("A1")
        q = q + 1
        If q > noWbs + 1 Then Exit Sub                        'Number of files is pulled
      End If
    Next
    wb.Close False
    myfile = Dir
  Loop
  ActiveWorkbook.Save
End Sub
 
Upvote 0
Thank you for this Dante!

Can I ask you to change it a little for me? I need to ask it not to copy in the sheet name with P&L 2019 - US GAAP...
I've tried adding an and to the if statement

If UCase(Left(sh.Name, 3)) = UCase("P&L") And sh.Name <> "*US*" Then

But it is not working

This code pastes links to the last file, is it possible to drop in the code to break the links? Or just paste values and format.

Any help much appreciated!
Kind regards,
Paula


Try this

Code:
Sub Template_Consol()
  Dim myfile As String, q As Long, filepath As String, noWbs As Byte, wb As Workbook, sh As Worksheet
  '
  Application.ScreenUpdating = False
  Application.AskToUpdateLinks = False
  Application.DisplayAlerts = False
  '
  q = 1
  noWbs = Sheets("inputs for Macro").Range("b3")              'This picks up the number of workbooks from the input cell
  filepath = Sheets("Inputs for Macro").Range("b2")           'Pick filepath from cell B3
  If Right(filepath, 1) <> "\" Then filepath = filepath & "\" 'Add backslash to the end of the filepath
  myfile = Dir(filepath)
  Do While Len(myfile) > 0
    Set wb = Workbooks.Open(filepath & myfile)
    For Each sh In wb.Sheets
[COLOR=#0000ff]      If UCase(Left(sh.Name, 3)) = UCase("P&L") Then          'The sheet name will start with P&L[/COLOR]
        sh.UsedRange.Copy ThisWorkbook.Sheets(q).Range("A1")
        q = q + 1
        If q > noWbs + 1 Then Exit Sub                        'Number of files is pulled
      End If
    Next
    wb.Close False
    myfile = Dir
  Loop
  ActiveWorkbook.Save
End Sub
 
Upvote 0
If I understand correctly: you just need to check that the string value isn't contained in the sheet name:

Code:
    For Each sh In wb.Sheets
[COLOR=#ff0000]        If InStr(1, wb.Name, "P&L 2019 - US GAAP") = 0 Then[/COLOR]
            If UCase(Left(sh.Name, 3)) = UCase("P&L") Then          'The sheet name will start with P&L
              sh.UsedRange.Copy ThisWorkbook.Sheets(q).Range("A1")
              q = q + 1
              If q > noWbs + 1 Then Exit Sub                        'Number of files is pulled
            End If
[COLOR=#ff0000]        End If[/COLOR]
    Next
 
Upvote 0
Thank you for this Gallen. I've dropped in that line of code, and I'm getting the error "Next without for"

Any ideas?



If I understand correctly: you just need to check that the string value isn't contained in the sheet name:

Code:
    For Each sh In wb.Sheets
[COLOR=#ff0000]        If InStr(1, wb.Name, "P&L 2019 - US GAAP") = 0 Then[/COLOR]
            If UCase(Left(sh.Name, 3)) = UCase("P&L") Then          'The sheet name will start with P&L
              sh.UsedRange.Copy ThisWorkbook.Sheets(q).Range("A1")
              q = q + 1
              If q > noWbs + 1 Then Exit Sub                        'Number of files is pulled
            End If
[COLOR=#ff0000]        End If[/COLOR]
    Next
 
Upvote 0
Thank you for this Dante!

(1) If UCase(Left(sh.Name, 3)) = UCase("P&L") And sh.Name <> "*US*" Then

(2) This code pastes links to the last file, is it possible to drop in the code to break the links? Or just paste values and format.

Try this

Code:
Sub Template_Consol()
  Dim myfile As String, q As Long, filepath As String, noWbs As Byte, wb As Workbook, sh As Worksheet
  '
  Application.ScreenUpdating = False
  Application.AskToUpdateLinks = False
  Application.DisplayAlerts = False
  '
  q = 1
  noWbs = Sheets("inputs for Macro").Range("b3")              'This picks up the number of workbooks from the input cell
  filepath = Sheets("Inputs for Macro").Range("b2")           'Pick filepath from cell B3
  If Right(filepath, 1) <> "\" Then filepath = filepath & "\" 'Add backslash to the end of the filepath
  myfile = Dir(filepath)
  Do While Len(myfile) > 0
    Set wb = Workbooks.Open(filepath & myfile)
    For Each sh In wb.Sheets
      If InStr(1, UCase(sh.Name), "US") = 0 Then                '[COLOR=#ff0000](1)[/COLOR] Not copy sheet whit US
        If UCase(Left(sh.Name, 3)) = UCase("P&L") Then          'The sheet name will start with P&L
          sh.UsedRange.Copy
          ThisWorkbook.Sheets(q).Range("A1").PasteSpecial xlPasteValues   [COLOR=#0000ff]'(2)[/COLOR]
          ThisWorkbook.Sheets(q).Range("A1").PasteSpecial xlPasteFormats
          q = q + 1
          If q > noWbs + 1 Then Exit Sub                        'Number of files is pulled
        End If
      End If
    Next
    wb.Close False
    myfile = Dir
  Loop
  ActiveWorkbook.Save
End Sub
 
Upvote 0
Thanks Dante, this code is giving me an error...
"object variable or with block variable not set"
Any ideas?

Kind regards,

Paula.

Try this

Code:
Sub Template_Consol()
  Dim myfile As String, q As Long, filepath As String, noWbs As Byte, wb As Workbook, sh As Worksheet
  '
  Application.ScreenUpdating = False
  Application.AskToUpdateLinks = False
  Application.DisplayAlerts = False
  '
  q = 1
  noWbs = Sheets("inputs for Macro").Range("b3")              'This picks up the number of workbooks from the input cell
  filepath = Sheets("Inputs for Macro").Range("b2")           'Pick filepath from cell B3
  If Right(filepath, 1) <> "\" Then filepath = filepath & "\" 'Add backslash to the end of the filepath
  myfile = Dir(filepath)
  Do While Len(myfile) > 0
    Set wb = Workbooks.Open(filepath & myfile)
    For Each sh In wb.Sheets
      If InStr(1, UCase(sh.Name), "US") = 0 Then                '[COLOR=#ff0000](1)[/COLOR] Not copy sheet whit US
        If UCase(Left(sh.Name, 3)) = UCase("P&L") Then          'The sheet name will start with P&L
          sh.UsedRange.Copy
          ThisWorkbook.Sheets(q).Range("A1").PasteSpecial xlPasteValues   [COLOR=#0000ff]'(2)[/COLOR]
          ThisWorkbook.Sheets(q).Range("A1").PasteSpecial xlPasteFormats
          q = q + 1
          If q > noWbs + 1 Then Exit Sub                        'Number of files is pulled
        End If
      End If
    Next
    wb.Close False
    myfile = Dir
  Loop
  ActiveWorkbook.Save
End Sub
 
Upvote 0
Thanks Dante, this code is giving me an error...
"object variable or with block variable not set"
Any ideas?

Kind regards,

Paula.

The macro works for me.
Did you modify some of the macro?
On which line does it stop or which line is marked?
 
Upvote 0
Your right I must have modified it, I've re-pasted that and its working fine for me now.

Thank you so much for your help! Much appreciated :cool:

The macro works for me.
Did you modify some of the macro?
On which line does it stop or which line is marked?
 
Upvote 0
Your right I must have modified it, I've re-pasted that and its working fine for me now.

Thank you so much for your help! Much appreciated :cool:

I'm glad to help you. Thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,238
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top