Dailycode.info

Short solution for short problems

Find strings in Excel sheet

How can we look up a string in an Excel sheet? With normal Excel code it is easy using the FIND function, but when you want to use a VBA function on all results of the find operation, you'll need a custom function:

Function FindAll(SearchRange As Range, FindWhat As Variant, _
    Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlWhole, _
    Optional SearchOrder As XlSearchOrder = xlByRows, _
    Optional MatchCase As Boolean = False) As Range
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' FindAll
' This returns a Range object that contains all the cells in SearchRange in which FindWhat
' was found. The parameters to the function have the same meaning as they do for the
' Find method of the Range object. If no cells were found, the result of this function
' is Nothing.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim FoundCell As Range
Dim FoundCells As Range
Dim LastCell As Range
Dim FirstAddr As String
With SearchRange
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' In order to have Find search for the FindWhat value
    ' starting at the first cell in the SearchRange, we
    ' have to find the last cell in SearchRange and use
    ' that as the cell after which the Find will search.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Set LastCell = .Cells(.Cells.Count)
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Do the initial Find. If we don't find FindWhat in the first Find,
' we won't even go into the code which searches for subsequent
' occurances.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set FoundCell = SearchRange.Find(what:=FindWhat, after:=LastCell, _
    LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
If Not FoundCell Is Nothing Then
    ''''''''''''''''''''''''''''''
    ' Set the FoundCells range
    ' to the first FoundCell.
    ''''''''''''''''''''''''''''''
    Set FoundCells = FoundCell
    ''''''''''''''''''''''''''''
    ' FirstAddr will contain the
    ' address of the first found
    ' cell. We test each FoundCell
    ' to this address to prevent
    ' the Find from looping back
    ' through the range it has
    ' already searched.
    ''''''''''''''''''''''''''''
    FirstAddr = FoundCell.Address
    Do
        ''''''''''''''''''''''''''''''''
        ' Loop calling FindNext until
        ' FoundCell is nothing or
        ' we wrap around the first
        ' found cell (address is in
        ' FirstAddr).
        '''''''''''''''''''''''''''''''
        Set FoundCells = Application.Union(FoundCells, FoundCell)
        Set FoundCell = SearchRange.FindNext(after:=FoundCell)
    Loop Until (FoundCell Is Nothing) Or (FoundCell.Address = FirstAddr)
End If
''''''''''''''''''''
' Return the result.
''''''''''''''''''''
If FoundCells Is Nothing Then
    Set FindAll = Nothing
Else
    Set FindAll = FoundCells
End If
End Function
 

This function returns an array of ranges containing the ranges where the searched string was in. After you can perform operations on the result values like this:

Private Sub FindAndDeleteCells()
    Dim SearchRange As Range
    Dim FoundCells As Range
    Dim FoundCell As Range
    Dim FindWhat As Variant
    Dim MatchCase As Boolean
    Dim LookIn As XlFindLookIn
    Dim LookAt As XlLookAt
    Dim SearchOrder As XlSearchOrder
    
    ''''''''''''''''''''''''''
    ' Set the variables to the
    ' appropriate values.
    ''''''''''''''''''''''''''
    Set SearchRange = ThisWorkbook.Worksheets(1).Range("A1:D20")
    FindWhat = "Large"
    LookIn = xlValues
    LookAt = xlPart
    SearchOrder = xlByRows
    MatchCase = False
    
    '''''''''''''''''''
    ' Search the range.
    '''''''''''''''''''
    Set FoundCells = FindAll(SearchRange:=SearchRange, FindWhat:=FindWhat, _
        LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
    
    ''''''''''''''''''''''
    ' Display the results.
    ''''''''''''''''''''''
    If FoundCells Is Nothing Then
        Debug.Print "No cells found."
    Else
        For Each FoundCell In FoundCells.Cells
            ' Now we delete the cell and the 3 cells on the right
            FoundCell.Cells.Activate
            FoundCell.Cells.Clear
            FoundCell.Offset(0, 1).Activate
            FoundCell.Offset(0, 1).Clear
            FoundCell.Offset(0, 2).Clear
            FoundCell.Offset(0, 3).Clear
            'Delete the Cells
            ' If you only want ot delete the cells, then use this code:
            'FoundCell.Rows.Delete
            
            'Delete the entire row
            'If you want to delete the entire row then use this code:
            Dim i As Long
            For i = FoundCell.Rows.Count To 1 Step -1
                    FoundCell.Rows(i).EntireRow.Delete
            Next i
        Next FoundCell
    End If
End Sub


Export data from Lotus Notes to Excel

The following code lets you choose a view and all the data from the view is exported to Excel automatically.
Very useful and completely free!

Place this code as an Agent in Lotus Notes Designer, and run the code from the Actions-menu.

Sub Initialize
      'Create an Excel Spreadsheet from any view
     '11/3/2000 Art Yates
 Dim Session As New NotesSession ,db As NotesDatabase
 Dim sourceview As NotesView,sourcedoc As NotesDocument
 Dim dataview As NotesView, dc As NotesDocumentCollection
 Dim datadoc As NotesDocument, maxcols As Integer
 Dim WS As New Notesuiworkspace
 Dim ViewString As String, Scope As String, GetField As Variant
 Dim C As NotesViewColumn, FieldName As String, K As Integer,N As Integer
 Dim xlApp As Variant, xlsheet As Variant, rows As Integer, cols As Integer
 Dim nitem As NotesItem , entry  As NotesViewEntry, vwNav As NotesViewNavigator
 Dim ShowView()  As Variant, i As Integer, VList As Variant, ColVals As Variant
 
 Set db = session.CurrentDatabase   'link to current database
 
 'fetch then display a list of views in the database
 Vlist= db.views
 K=Ubound(Vlist)  'get size of list
 Redim Preserve ShowView(K)
 N=-1
 For i = 0 To K
  If Len(Vlist(i).Name) >0 Then 
   FieldName=Trim(Vlist(i).Name)
   If Mid(Fieldname,1,1) <>"(" Then  'do not show hidden views
    N=N+1    
    ShowView(N) = FieldName
   End If
  End If 
 Next i 
 Redim Preserve ShowView(N)
     'now sort the list - by default views are listing in the order that they were created
 For i=0 To N
  For K=i To N
   If  ShowView(i) > ShowView(k) Then
    FieldName=ShowView(i) 
    ShowView(i) = ShowView(k)
    ShowView(k)=FieldName
   End If
  Next k
 Next i 
 
 viewstring= ws.Prompt(PROMPT_OKCANCELLIST,"List of Views","Choose a View","",ShowView )
 If Len(viewstring)=0 Then Exit Sub
  'ViewString ="Dan's View"
 
 Set dataview = db.getview(ViewString)  'get selected view
 
 Set vwnav= dataview.createViewnav()
 
 rows = 1
 cols = 1
 maxcols=dataview.ColumnCount  'how many columns?
 
 Set xlApp = CreateObject("Excel.Application")  
'start Excel with OLE Automation
 xlApp.StatusBar = "Creating WorkSheet. Please be patient..."
 xlApp.Visible = True
 xlApp.Workbooks.Add
 xlApp.ReferenceStyle = 2
 Set xlsheet = xlApp.Workbooks(1).Worksheets(1)  
 'select first worksheet
 
 'worksheet title
 xlsheet.Cells(rows,cols).Value ="View: " + ViewString + ", from Database: " 
+  db.title +",  Extract created on: " +  Format(Now,"mm/dd/yyyy HH:MM")
 
 xlApp.StatusBar = "Creating Column Heading. Please be patient..."
 
 rows=2  'column headings starts in row 2
 For K=1 To maxcols
  Set c=dataview.columns(K-1)
  xlsheet.Cells(rows,cols).Value = c.title
  cols = cols + 1
 Next K
 
 Set entry=vwnav.GetFirstDocument
 rows=3   'data starts in third row
 Do While Not (entry Is Nothing)
  
  For cols=1 To maxcols 
   colvals=entry.ColumnValues(cols-1) 'subscript =0
   scope=Typename(colvals)
   Select Case scope
   Case "STRING"
    xlsheet.Cells(rows,cols).Value ="'" +  colvals
   Case Else 
    xlsheet.Cells(rows,cols).Value = colvals
   End Select   
  Next cols  
  xlApp.StatusBar = "Importing Notes Data   -    Document " & (rows-1) 
  rows=rows+1
  Set entry = vwnav.getnextdocument(entry)  
 Loop
 
 xlApp.Rows("1:1").Select
 xlApp.Selection.Font.Bold = True
 xlApp.Selection.Font.Underline = True
 xlApp.Range(xlsheet.Cells(2,1), xlsheet.Cells(rows,maxcols)).Select
 xlApp.Selection.Font.Name = "Arial"
 xlApp.Selection.Font.Size = 9
 xlApp.Selection.Columns.AutoFit
 With xlApp.Worksheets(1)
  .PageSetup.Orientation = 2
  .PageSetup.centerheader = "Report - Confidential"
  .Pagesetup.RightFooter = "Page &P" & Chr$(13) & "Date: &D"
  .Pagesetup.CenterFooter = ""
 End With
 xlApp.ReferenceStyle = 1
 xlApp.Range("A1").Select
 xlApp.StatusBar = "Importing Data from Lotus Notes Application was Completed."
 'xlapp.ActiveWorkbook.saveas "c:VX" + Trim(Format(Now,"yyy"))   'save with generated name
 dataview.clear 
 
 Set xlapp=Nothing   'stop OLE
 Set db=Nothing
End Sub 

Reference calculated fields

 When we use advanced functions, sometimes we need to reference one calculated field to an other. In Sharepoint this is possible.
And when we accidently make circular references we get this wonderful error:

The formula contains a circular reference (the calculated column refers to itself).  You must remove or change the circular reference.

 

Here is an example of a formula based on an other calculated field:

=IF(ISNUMBER(FIND("\",[calcfield])),RIGHT([calcfield],LEN([calcfield])-FIND("\",[calcfield])),"") 

 

This fomula checks if the field contains a "\", and if it does, it takes the substring on the right of the "\",
else it displays and empty string: "".

You can find everything on functions that you can use in calculated fields on: http://office.microsoft.com/en-us/sharepointtechnology/HA011609471033.aspx