title: Excel VBA Macro to get the substring of text before semicolon
body: <p>I have working code here.</p>
  
  <p>In section (3) it grabs values from a cell under a specific header and prints them to a masterfile. These values typically look like </p>
  
  <p><strong>TL-18273982; 10MM</strong></p>
  
  <p><strong>TL-288762; 76DK</strong></p>
  
  <p><strong>CT-576</strong></p>
  
  <p><strong>N/A</strong> </p>
  
  <p>I would like to grab just the information that is before the first semicolon. Not all the cells have a semi colon in them so it would probably need an if statement along the lines of if ; then print everything in front of it. </p>
  
  <p>I have been trying to utilize a split function to do this but I am not very experienced with VBA so I am having some trouble. Any suggestions?</p>
  
  <pre><code>Option Explicit
  
  Sub LoopThroughDirectory()
  
      Const ROW_HEADER As Long = 10
  
      Dim objFSO As Object
      Dim objFolder As Object
      Dim objFile As Object
      Dim MyFolder As String
      Dim StartSht As Worksheet, ws As Worksheet
      Dim WB As Workbook
      Dim i As Integer
      Dim LastRow As Integer, erow As Integer
      Dim Height As Integer
      Dim RowLast As Long
      Dim f As String
      Dim dict As Object
      Dim hc As Range, hc1 As Range, hc2 As Range, hc3 As Range, d As Range
  
      Set StartSht = Workbooks("masterfile.xlsm").Sheets("Sheet1")
  
      'turn screen updating off - makes program faster
      Application.ScreenUpdating = False
  
      'location of the folder in which the desired TDS files are
      MyFolder = "C:\Users\trembos\Documents\TDS\progress\"
  
      'find the headers on the sheet
      Set hc1 = HeaderCell(StartSht.Range("B1"), "HOLDER")
      Set hc2 = HeaderCell(StartSht.Range("C1"), "CUTTING TOOL")
  
      'create an instance of the FileSystemObject
      Set objFSO = CreateObject("Scripting.FileSystemObject")
      'get the folder object
      Set objFolder = objFSO.GetFolder(MyFolder)
      i = 2
  
  
      'loop through directory file and print names
  '(1)
      For Each objFile In objFolder.Files
          If LCase(Right(objFile.Name, 3)) = "xls" Or LCase(Left(Right(objFile.Name, 4), 3)) = "xls" Then
  '(2)
  
              'Open folder and file name, do not update links
              Set WB = Workbooks.Open(fileName:=MyFolder &amp; objFile.Name, UpdateLinks:=0)
              Set ws = WB.ActiveSheet
  '(3)
                  'find CUTTING TOOL on the source sheet
                  Set hc = HeaderCell(ws.Cells(ROW_HEADER, 1), "CUTTING TOOL")
                  If Not hc Is Nothing Then
  
                      Set dict = GetValues(hc.Offset(1, 0))
                      If dict.count &gt; 0 Then
                          Set d = StartSht.Cells(Rows.count, hc2.Column).End(xlUp).Offset(1, 0)
                          'add the values to the masterfile, column 3
                          d.Resize(dict.count, 1).Value = Application.Transpose(dict.items)
                      End If
                  Else
                      'header not found on source worksheet
                  End If
  '(4)
                  'find HOLDER on the source sheet
                  Set hc3 = HeaderCell(ws.Cells(ROW_HEADER, 1), "HOLDER")
                  If Not hc3 Is Nothing Then
  
                      Set dict = GetValues(hc3.Offset(1, 0))
                      If dict.count &gt; 0 Then
                          Set d = StartSht.Cells(Rows.count, hc1.Column).End(xlUp).Offset(1, 0)
                          'add the values to the master list, column 2
                          d.Resize(dict.count, 1).Value = Application.Transpose(dict.items)
                      End If
                  Else
                      'header not found on source worksheet
                  End If
  '(5)
              With WB
                 'print TDS information
                  For Each ws In .Worksheets
                          'print the file name to Column 1
                          StartSht.Cells(i, 1) = objFile.Name
                          'print TDS name from J1 cell to Column 4
                          With ws
                              .Range("J1").Copy StartSht.Cells(i, 4)
                          End With
                          i = GetLastRowInSheet(StartSht) + 1
                  'move to next file
                  Next ws
  '(6)
                  'close, do not save any changes to the opened files
                  .Close SaveChanges:=False
              End With
          End If
      'move to next file
      Next objFile
      'turn screen updating back on
      Application.ScreenUpdating = True
      ActiveWindow.ScrollRow = 1
  '(7)
  End Sub
  
  '(8)
  'get all unique column values starting at cell c
  Function GetValues(ch As Range) As Object
      Dim dict As Object, rng As Range, c As Range, v
      Set dict = CreateObject("scripting.dictionary")
      For Each c In ch.Parent.Range(ch, ch.Parent.Cells(Rows.count, ch.Column).End(xlUp)).Cells
          v = Trim(c.Value)
          If Len(v) &gt; 0 And Not dict.exists(v) Then
              dict.Add c.Address, v
          End If
      Next c
      Set GetValues = dict
  End Function
  
  '(9)
  'find a header on a row: returns Nothing if not found
  Function HeaderCell(rng As Range, sHeader As String) As Range
      Dim rv As Range, c As Range
      For Each c In rng.Parent.Range(rng, rng.Parent.Cells(rng.Row, Columns.count).End(xlToLeft)).Cells
          If Trim(c.Value) = sHeader Then
              Set rv = c
              Exit For
          End If
      Next c
      Set HeaderCell = rv
  End Function
  
  '(10)
  Function GetLastRowInColumn(theWorksheet As Worksheet, col As String)
      With theWorksheet
          GetLastRowInColumn = .Range(col &amp; .Rows.count).End(xlUp).Row
      End With
  End Function
  
  '(11)
  Function GetLastRowInSheet(theWorksheet As Worksheet)
  Dim ret
      With theWorksheet
          If Application.WorksheetFunction.CountA(.Cells) &lt;&gt; 0 Then
              ret = .Cells.Find(What:="*", _
                            After:=.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
          Else
              ret = 1
          End If
      End With
      GetLastRowInSheet = ret
  End Function
  </code></pre>