Online Trick

Sub wiki()

Dim searchstr As String
Dim searchsadd As String

searchstr = ActiveCell.Value
searchadd = "http://en.wikipedia.org/w/index.php?title=Special%3ASearch&profile=default&search=" & searchstr & "&fulltext=Search"
  
  If Len(searchstr) = 0 Then
    MsgBox "The active cell is empty.. Nothing to search for..", vbOKOnly, "WIKIPEDIA"

  Else:
    ActiveWorkbook.FollowHyperlink searchadd, NewWindow:=True
    Application.StatusBar = "WIKI search for: " & searchstr
  End If
  
End Sub

Function Substring2(theString As String, str1 As String, repstr1 As Integer, Optional str2 As Variant, Optional repStr2 As Variant) As String

    '****************************************************************************************************************
    'author:    kay cichini
    'date:      04112014
    'purpose:   find substring deligned by the x-th repition of one string at the left side
    '           and anothers string x-th repition at the right side
    'str1:      first string to be matched
    'str2:      second string to be matched, optional
    'repstr1:   nth repition of str1 to be matched
    'repstr2:   nth repition of str2 to be matched, optional
    '           with optional arguments ommited function will return substring ending with the last character of the
    '           searchstring
    '----------------------------------------------------------------------------------------------------------------
    'example:   Substring2("1234 678 101214 xxxx"; " "; 2; "x"; 3)
    '           will match position 10 after the second repition of str1, find position 20 after the third "x"
    '           then apply a mid-function with signature 'mid(string, start, length)',
    '           where the position 10 is the start and length is position 20 - len("x") - 10 = 9
    '           and the result is "101214 xx"
    '****************************************************************************************************************
    
    Dim start1, start2, lenStr1, lenStr2, length As Integer
    
    If IsMissing(str2) And IsMissing(repStr2) Then
    
        'case when last char in string should be matched
        '-----------------------------------------------
        
        start1 = 1
        lenStr1 = Len(str1)
        
        If InStr(start1, theString, str1) = 0 Then
            '0 -> String couldn't be matched!
            Exit Function
        End If
        
        For i = 0 To repstr1 - 1
            start1 = InStr(start1, theString, str1) + lenStr1
        Next i
        
        length = Len(theString) - start1 + 1
        Substring2 = Mid(theString, start1, length)

    Else
    
        'other cases
        '-----------
        start1 = 1
        lenStr1 = Len(str1)
        start2 = 1
        lenStr2 = Len(str2)
        
        If InStr(start1, theString, str1) = 0 Or InStr(start2, theString, str2) = 0 Then
            '0 -> String couldn't be matched!
            Exit Function
        End If
        
        For i = 0 To repstr1 - 1
            start1 = InStr(start1, theString, str1) + lenStr1
        Next i
        
        For i = 0 To repStr2 - 1
            start2 = InStr(start2, theString, str2) + lenStr2
        Next i

        length = start2 - lenStr2 - start1
        Substring2 = Mid(theString, start1, length)
        
    End If
    
End Function

Sub Export_CSV()

    '***************************************************************************************
    'author:    kay cichini
    'date:      26102014
    'purpose:   export current spreadsheet to csv.file to the same file path as source file
    '
    ' !!NOTE!!  files with same name and path will be overwritten
    '***************************************************************************************
  

    Dim MyPath As String
    Dim MyFileName As String
    Dim WB1 As Workbook, WB2 As Workbook
    
    Set WB1 = ActiveWorkbook
    ActiveWorkbook.ActiveSheet.UsedRange.Copy

    Set WB2 = Application.Workbooks.Add(1)
    WB2.Sheets(1).Range("A1").PasteSpecial xlPasteValues
    
    MyFileName = "CSV_Export_" & Format(Date, "ddmmyyyy")
    FullPath = WB1.Path & "\" & MyFileName
    
    Application.DisplayAlerts = False
    If MsgBox("Data copied to " & WB1.Path & "\" & MyFileName & vbCrLf & _
    "Warning: Files in directory with same name will be overwritten!!", vbQuestion + vbYesNo) <> vbYes Then
        Exit Sub
    End If
    
    If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
    With WB2
        .SaveAs Filename:=FullPath, FileFormat:=xlCSV, CreateBackup:=False
        .Close True
    End With
    Application.DisplayAlerts = True
End Sub