Need Help in Editing VBA Code that currently copies over worksheets to another workbook

Viewed 28

I have limited knowledge in VBA, but I need help with a Macro that currently copies over excel worksheets to another excel workbook. The way it currently works though is that it copies over worksheets that have a numeric name for example only worksheets that are titled with 6 Digits for Example "140655". What I want the Macro to do now though is to not only copy over the worksheets that have a name with 6 digits Ex."140655" but also have a standard English name such as "Budget". Can someone assist with editing the code to also copy over the worksheets with English names such as for Ex."Budget". Here is the code.

Const CalcDelay = 0.00000578704

Dim CopyRange As String
Dim PasteRange As String
Dim ScanFileOpen As Byte
Dim ScanCount As Byte
Dim ScanSaveSpec As String
Dim ScanSaveFile As String
Dim ReturnWindow As String
Dim ReportFile As String
Dim ExcelVersion As String

Sub OpenReportFile()
ReturnWindow = [ProcessWinSpec].Value

If [ReportFileFlag].Value = True Then
  Application.ScreenUpdating = False
  Workbooks.Open Filename:=[ReportFileSpec].Value
  Windows(ReturnWindow).Activate
  Application.ScreenUpdating = True
Else
    MsgBox ("Error: File not found")
End If

End Sub

Sub DoScan()
Dim Work As Variant
Dim X As Interger

ReturnWindow = [ProcessWinSpec].Value
ReportFile = [ReportFileName].Value

ExcelVersion = IIf([FileNameExt].Value = ".xls", 2003, 2013)

For Each Work In [ScanFlags]


    ScanFileOpen = 0
    ScanCount = 0

    If Work.Value = 1 Then

        [ScanName].Value = Work.Offset(0, 1).Value
        [ScanCalcRange].Calculate
        ScanSaveFile = [ScanFile].Value
        ScanSaveSpec = [ScanSpec].Value

    For X = Work.Offset(0, 2).Value To 1 Step -1
          ScanTabName = Work.Offset(0, X + 2).Value
         [ScanTab].Value = ScanTabName
         [ScanCalcRange].Calculate
             If [ReadFlag].Value = 1 Then DoCopyTab
    Next
   End If
   If ScanFileOpen = 1 Then
         ActiveWorkbook.Save
         ActiveWindow.Close

   End If



Next


End Sub

1 Answers

With regards to your question on how to excecute a macro if files have a certain name, probably the best approach would be to create an array of words, and then loop through them seeking a match. See example with your code:

Sub OpenReportFile()
    Const yourWords = "budget,actual,accept" '<--- fill these in separated by comman
    ReturnWindow = [ProcessWinSpec].Value
    Dim foundMatch As Boolean
    
    If [ReportFileFlag].Value = True Then
        foundMatch = True
    Else
        
        Dim wordArray() As String, i As Long
        wordArray = Split(yourWords, ",")
        
        'loopS through words
        For i = LBound(wordArray) To UBound(wordArray)
            If UCase(wordArray(i)) = UCase([ReportFileFlag].Value) Then
                foundMatch = True
                Exit For 'exits loop after match
            End If
        Next i
    End If
    
    If foundMatch Then
      Application.ScreenUpdating = False
      Workbooks.Open Filename:=[ReportFileSpec].Value
      Windows(ReturnWindow).Activate
      Application.ScreenUpdating = True
    Else
        MsgBox ("Error: File not found")
    End If

End Sub

As you can see in the comments, your question isn't receiving the most favorable feedback as far as clarity. If this doesn't work, you may want to consider eleting your question and reposting after more carefully reviewing How to ask a question

Related