title: How to select columns based on header in excel vba project
body: <p>I am currently working on an Excel VBA project which merges data from multiple workbooks.</p>
  
  <p>The workbooks are identical in terms of columns but have variable row lengths.</p>
  
  <p>I would like to only extract data from Columns with the header "School Name", "Participants" and "Status". These are the cells B2, G2 and H2. Thus, effectively, I only want the data from columns B, G and H.</p>
  
  <p>Currently, I extract data using a set range (B3:H80) and then delete the unwanted columns. How do I edit the source range to .usedrange and edit that accordingly?</p>
  
  <p>I have attached the code below. Thanks for your help!</p>
  
  <pre><code>Private Sub MergeAllWorkbooks()
  Dim MyPath As String, FilesInPath As String
  Dim MyFiles() As String
  Dim SourceRcount As Long, FNum As Long
  Dim mybook As Workbook, BaseWks As Worksheet
  Dim sourceRange As Range, destrange As Range
  Dim rnum As Long, CalcMode As Long
  
  
  ' Change this to the path\folder location of your files.
  MyPath = "C:\Users\" &amp; Environ("username") &amp; "\Dropbox\Folder1\"
  
  ' Add a slash at the end of the path if needed.
  If Right(MyPath, 1) &lt;&gt; "\" Then
      MyPath = MyPath &amp; "\"
  End If
  
  ' If there are no Excel files in the folder, exit.
  FilesInPath = Dir(MyPath &amp; "*.xl*")
  If FilesInPath = "" Then
      MsgBox "No files found"
      Exit Sub
  End If
  
  ' Fill the myFiles array with the list of Excel files
  ' in the search folder.
  FNum = 0
  Do While FilesInPath &lt;&gt; ""
      FNum = FNum + 1
      ReDim Preserve MyFiles(1 To FNum)
      MyFiles(FNum) = FilesInPath
      FilesInPath = Dir()
  Loop
  
  ' Set various application properties.
  With Application
      CalcMode = .Calculation
      .Calculation = xlCalculationManual
      .ScreenUpdating = False
      .EnableEvents = False
  End With
  
  ' Add a new workbook with one sheet.
  Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
  rnum = 1
  
  ' Loop through all files in the myFiles array.
  If FNum &gt; 0 Then
      For FNum = LBound(MyFiles) To UBound(MyFiles)
          Set mybook = Nothing
          On Error Resume Next
          Set mybook = Workbooks.Open(MyPath &amp; MyFiles(FNum))
          On Error GoTo 0
  
          If Not mybook Is Nothing Then
              On Error Resume Next
  
              ' Change this range to fit your own needs.
              With mybook.Worksheets(1)
                  Set sourceRange = .Range("B3:H80")
              End With
  
              If Err.Number &gt; 0 Then
                  Err.Clear
                  Set sourceRange = Nothing
              Else
                  ' If source range uses all columns then
                  ' skip this file.
                  If sourceRange.Columns.Count &gt;= BaseWks.Columns.Count Then
                      Set sourceRange = Nothing
                  End If
              End If
              On Error GoTo 0
  
              If Not sourceRange Is Nothing Then
  
                  SourceRcount = sourceRange.Rows.Count
  
                  If rnum + SourceRcount &gt;= BaseWks.Rows.Count Then
                      MsgBox "There are not enough rows in the target worksheet."
                      BaseWks.Columns.AutoFit
                      mybook.Close savechanges:=False
                      GoTo ExitTheSub
                  Else
  
                      ' Copy the file name in column C.
                      With sourceRange
                          BaseWks.Cells(rnum, "C"). _
                                  Resize(.Rows.Count).Value = MyFiles(FNum)
                      End With
  
                      ' Set the destination range.
                      Set destrange = BaseWks.Range("B" &amp; rnum)
  
                      ' Copy the values from the source range
                      ' to the destination range.
                      With sourceRange
                          Set destrange = destrange. _
                                          Resize(.Rows.Count, .Columns.Count)
                      End With
                      destrange.Value = sourceRange.Value
  
                      rnum = rnum + SourceRcount
                  End If
              End If
              mybook.Close savechanges:=False
          End If
  
      Next FNum
      BaseWks.Columns.AutoFit
  End If
  
  ExitTheSub:
  ' Restore the application properties.
  With Application
      .ScreenUpdating = True
      .EnableEvents = True
      .Calculation = CalcMode
  End With
  
  Columns("C:F").Delete
  
  End Sub
  </code></pre>