Saturday, July 29, 2017

Excel Vba : Filtering Using Text Boxes

       A nice filtering template.
The value in textbox is searched as part or whole in the column. The results found are shown in the column, the other data are hidden.


Search and filtering are performed when button is clicked. The codes :

Private Sub CommandButton2_Click()
Dim aCell As Range, bCell As Range
    Dim SearchString As String, son As Long
    Dim RngOne As Range, cell As Range
  
    On Error GoTo Whoa
If TextBox3.Value = Empty Then
MsgBox "Please, Enter A Value To Textbox", vbCritical, ""
Exit Sub
End If
            
   ActiveSheet.Range("A3:K3").AutoFilter
   Range("AN:AN").Clear
   Sheets("Data").Cells.EntireRow.Hidden = False
   SearchString = TextBox3.Value
   Range("F:F").Activate

Select Case TextBox3.Value
Case "?"
TextBox3.Value = "~?"
Case "*"
TextBox3.Value = "~*"
Case "%"
GoTo bura_a
Case "="
GoTo bura_a
Case IsNumeric(TextBox3)
GoTo bura_a
End Select

If OptionButton1.Value = True And Not IsNumeric(TextBox3.Value) Then
GoTo bura1
ElseIf OptionButton2.Value = True And Not IsNumeric(TextBox3.Value) Then
GoTo bura2
End If

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False

bura_a:
If OptionButton1.Value = True Then
  ActiveSheet.Range("A3:K3").AutoFilter
     Set aCell = Range("F4:F" & Range("F" & Rows.Count).End(xlUp).Row).Find(what:=SearchString, LookIn:=xlValues, _
                LookAt:=xlPart)
    
   ElseIf OptionButton2.Value = True Then
   ActiveSheet.Range("A3:K3").AutoFilter
    Set aCell = Range("F4:F" & Range("F" & Rows.Count).End(xlUp).Row).Find(what:=SearchString, LookIn:=xlValues, _
              LookAt:=xlWhole)
    End If
    
    Application.Goto Sheets("Data").Range("A4"), Scroll:=True
    Application.ScreenUpdating = True
    Label1.Visible = True
    Application.ScreenUpdating = False
    
 Sheets("Data").Cells.EntireRow.Hidden = False

    If Not aCell Is Nothing Then
        Set bCell = aCell
        Range("AN2").Value = aCell.Address(False, False)
        Do
        son = 0
            Set aCell = Range("F4:F" & Range("F" & Rows.Count).End(xlUp).Row).FindNext(After:=aCell)
         If Not aCell Is Nothing Then
           If aCell.Address = bCell.Address Then Exit Do
      son = son + 1
    Range("AN" & Rows.Count).End(xlUp).Offset(son, 0).Value = aCell.Address(False, False)
        Else
                Exit Do
           End If
        Loop
 Label1.Visible = False
    Else
    Label1.Visible = False
    Range("G2").Activate
    MsgBox SearchString & " Not Found", vbCritical, ""
    Exit Sub
    End If
         
With Sheets("Data")
    Set RngOne = .Range("AN2:AN" & .Range("AN" & Sheets("Data").Rows.Count).End(xlUp).Row)
End With

Range("F4:F" & Range("F" & Rows.Count).End(xlUp).Row).EntireRow.Hidden = True
For Each cell In RngOne
Range(cell).EntireRow.Hidden = False
Next cell
MsgBox AutoFilter.Range.Columns(6).SpecialCells(xlCellTypeVisible).Cells.Count - 1 & " " & "Records Found", vbInformation, ""
     
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True

Set aCell = Nothing
Exit Sub

bura1:
Application.Goto Sheets("Data").Range("A4"), Scroll:=True
Label1.Visible = True

  ActiveSheet.AutoFilterMode = False
ActiveSheet.Range("A3:K3").AutoFilter
Label1.Visible = False
  Range("F4:F" & Range("F" & Rows.Count).End(xlUp).Row).AutoFilter field:=6, Criteria1:="*" & TextBox3.Value & "*"

   If AutoFilter.Range.Columns(6).SpecialCells(xlCellTypeVisible).Cells.Count - 1 = 0 Then
   ActiveSheet.ShowAllData
   Range("G2").Activate
   MsgBox SearchString & " Not Found", vbCritical, ""
   Else
MsgBox AutoFilter.Range.Columns(6).SpecialCells(xlCellTypeVisible).Cells.Count - 1 & " " & "Records Found", vbInformation, ""
   End If
  Exit Sub
  
bura2:
Application.Goto Sheets("Data").Range("A4"), Scroll:=True
Label1.Visible = True

ActiveSheet.AutoFilterMode = False
ActiveSheet.Range("A3:K3").AutoFilter
Label1.Visible = False
Range("F4:F" & Range("F" & Rows.Count).End(xlUp).Row).AutoFilter field:=6, Criteria1:=TextBox3.Value

If AutoFilter.Range.Columns(6).SpecialCells(xlCellTypeVisible).Cells.Count - 1 = 0 Then
ActiveSheet.ShowAllData
   Range("G2").Activate
   MsgBox SearchString & " Not Found", vbCritical, ""
   Else
      MsgBox AutoFilter.Range.Columns(6).SpecialCells(xlCellTypeVisible).Cells.Count - 1 & " " & "Records Found", vbInformation, ""
   End If
  Exit Sub
       
Whoa:
    MsgBox Err.Description
End Sub


Monday, May 29, 2017

Play Musical Notes In Excel



           Musical notes (piano notes) can be played with buttons and functional keys in Excel.

- Ago, we added buttons to the worksheet .Then ,we assigned the macros to these buttons to play the music notes(.wav files) that are in the same place as the workbook. Example ;

  Private Sub CommandButton2_Click()
  Call sndPlaySound32(ThisWorkbook.Path & "\a1.wav", 0)
  Range("F2").Activate
  End Sub

- If desired music notes can be played with function keys F1, F2 etc. We used the following codes for this process :

Sub A_1()
    Call sndPlaySound32(ThisWorkbook.Path & "\a1.wav", 0)
End Sub
Sub auto_open()
Application.OnKey "{F1}", "A_1"
....
End Sub