Sunday, September 17, 2017

Display The Pictures On Userform



         In this tutorial, selected image from computer is copied to folder which workbook is here. When the userform is loaded, the name of images with .jpg extension in the folder are sorted on the listbox. 
The image selected from the listbox is displayed on the “image control”. 

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

Sunday, May 21, 2017

Product Filtering Between Two Dates Using Userform

Between the selected dates ,product-based filtering can be done using the userform.



        When the dates (start date,end date) are entered in text boxes and if report button is pressed  the userform  elongation effect is activated and listbox appears.
When choosing a date to add into text boxes,the date userform was used instead of date picker control :


The found results are listed on the listbox.

Saturday, May 20, 2017

Excel Vba Class Module Examples

EXAMPLES OF VBA CLASS    

          In three separate workbooks, we have created useful userforms using class modules :

- Fast percentage calculation userform
- Product discount calculation according to quantity,price and percent rate
- Hiding / displaying the columns of sheet (column management with userform)



Wednesday, May 17, 2017

Find Data Between Two Dates In Excel Vba



          Records in between two specific dates easily can be filtered using drop-down lists .
Ago ,drop-down lists (combo boxes) were filled with unique values as ascending order using ADO connection.  Thus, it is easier to choose between the dates on the worksheet. The used codes for this :

Set con = CreateObject("adodb.connection")
Sheets("Page1").ComboBox1.Clear
Sheets("Page1").ComboBox2.Clear
    #If VBA7 And Win64 Then
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 12.0;hdr=yes"""
    #Else
con.Open "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=yes"""
    #End If       
Set rs = CreateObject("adodb.recordset")
sorgu = "select Date from [Page1$] group by Date"
rs.Open sorgu, con, 1, 1
While Not rs.EOF
Sheets("Page1").ComboBox1.AddItem VBA.Format(rs("Date").Value, "dd.mm.yyyy")
Sheets("Page1").ComboBox2.AddItem VBA.Format(rs("Date").Value, "dd.mm.yyyy")
rs.movenext
Wend

Then ,the data between the two dates selected from combo boxes is filtered through Vba codes :

 lngStart = VBA.CDate(Sheets("Page1").ComboBox1) 'assume this is the start date
    lngEnd = VBA.CDate(Sheets("Page1").ComboBox2) 'assume this is the end date
    If lngStart > lngEnd Then
    MsgBox "The Start Date Can Not Be Bigger Than The End Date.", vbCritical, ""
    Exit Sub
    End If
    Sheets("Page1").Range("B:B").AutoFilter field:=1, _
    Criteria1:=">=" & lngStart, Operator:=xlAnd, Criteria2:="<=" & lngEnd

The filtered data can be copied to other sheet if it wished.

Saturday, April 22, 2017

Creating Price Quote With Userform That Contains Cascading Drop-Down Lists


        In this study, we created a userform that automatically displayed to make it easier to enter data into the worksheet. The userform contains dependent combo boxes( combobox in which the list depends on the selection made in another combobox),textbox and button.


The Scripting Dictionary Object was used to fill in combo boxes :
Dim SD As Object
Set SD = CreateObject(“Scripting.Dictionary”)
For Each x In Supplier
SD(x) = “”
Next x
ComboBox1.List = SD.keys
excel price quote

Thursday, April 6, 2017

Create Simple Dynamic(Dependent) Drop Down Lists In Excel


       In worksheet, we can create dynamic drop down lists with the Data Validation feature and the Indirect function. 

In sample sheet,we have a table of five columns that indicate five types of foodstuff: fruit, food, meat,vegetable and drink and below them are the specific food name :
       We need to create one drop down list that contains the foodstuff, such as fruit, food, vegetable,meat and drink . The second drop-down would have the specific food name. If we select meat item from first drop-down, the second drop-down will show beef, mutton, chicken, port, fish and veal.
To do this, please apply the following steps:
First, we need to create range names for these columns and the first categories row.
- Let's create a range name for the categories,for this the first row, we selected the A1:E1, and typed the range name Foodstuff into the Name Box, then pressed Enter key.
- Then we need to name the range for each of the columns  as shown below:
excel dependent drop down list
- Now we can create the first drop down list, we selected a blank cell or a column that we want to apply this drop down list (I5 cell is selected), and then we clicked Data > Data Validation .In the Data Validation dialog box, we clicked Settings tab, we chose List from the Allow drop down list, and entered this formula =Foodstuff into the Source box.
Our first drop down list have been created.
- Then we can create the second drop down list,we selected J5 cell, and click Data > Data Validation again, in the Data Validation dialog box, we clicked Settings tab, we chose List from the Allow drop down list, and entered this formula =indirect($I$5) into the Source box.

Our dependent drop down list have been created successfully.
If user choose one type of the foodstuff, the corresponding cell will only display its specific food name.

Sunday, March 5, 2017

Creating Invoice And Entering Data Quickly Through Userforms


           In this invoice template ,the userforms that contains textbox,listbox and buttons are used to enter quickly data of customers and products:
- Requested data can be searched in lists(product list or customer list) through the text boxes . Then,     when the list item is double-clicked or when the enter key is pressed, the item's data is entered in       the sheet.
- The created macro gives warning using cell blink (flashing cell method) when product quantity not    entered to quantity range. -It can be seen in the above video-
- Addition and multiplication operations in column G are performed through formulas (=E21*F21,      =SUM(G21:G35) etc.) The used formulas in worksheet are protected by the following codes :
      Private Sub Worksheet_Change(ByVal Target As Range)
     If Target.Address = "$G$21" Then
      Target.Formula = "=E21*F21"
      ElseIf Target.Address = "$G$22" Then
      Target.Formula = "=E22*F22"
       ElseIf Target.Address = "$G$23" Then
      Target.Formula = "=E23*F23"
       ElseIf Target.Address = "$G$24" Then
      Target.Formula = "=E24*F24"
       ElseIf Target.Address = "$G$25" Then
      Target.Formula = "=E25*F25"
       ElseIf Target.Address = "$G$26" Then
      Target.Formula = "=E26*F26"
       ElseIf Target.Address = "$G$27" Then
      Target.Formula = "=E27*F27"
       ElseIf Target.Address = "$G$28" Then
      Target.Formula = "=E28*F28"
       ElseIf Target.Address = "$G$29" Then
      Target.Formula = "=E29*F292"
       ElseIf Target.Address = "$G$30" Then
      Target.Formula = "=E30*F30"
       ElseIf Target.Address = "$G$31" Then
      Target.Formula = "=E31*F31"
       ElseIf Target.Address = "$G$32" Then
      Target.Formula = "=E32*F32"
       ElseIf Target.Address = "$G$33" Then
      Target.Formula = "=E33*F33"
       ElseIf Target.Address = "$G$34" Then
      Target.Formula = "=E34*F34"
       ElseIf Target.Address = "$G$35" Then
      Target.Formula = "=E35*F35"
       ElseIf Target.Address = "$G$36" Then
      Target.Formula = "=SUM(G21:G35)"
       ElseIf Target.Address = "$G$41" Then
      Target.Formula = "=SUM(G36:G39)"
      End If
      End Sub

- The created invoice can be copied to selected record sheet.

Wednesday, January 25, 2017

Excel Vba Games

Fun Games Created With Excel VBA Codes

There are three games in three separate workboks:
  1. Tetris
  2. Find Matches
  3. Rocket

Thursday, January 19, 2017

Parsing Data Into Multiple Worksheets With Drop-Down Lists

     
         In this study, the row is copied to the sheet (e.g On_hire sheet) according to the value selected from the drop-down list in column H, and the row is deleted.

The following steps have been taken for data parsing into multiple sheets :
- "Options" name is defined for Range("J1:J3")

- Drop-down lists is created in Column H using Data Validation - List Method. The name we defined is entered to the "Source" section.

- The macro codes are added to Worksheet_Change Function in Vbe window :
"Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
If Target.Column = 8 Then
For i = 5 To Me.Cells(Rows.Count, 1).End(xlUp).Row
    If Cells(i, "H").Value = "On hire" Then
        Rows(i).Copy
        Sheets("On_hire").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Rows(i).Delete
        i = i - 1
    ElseIf Cells(i, "H").Value = "Off hire" Then
        Rows(i).Copy
        Sheets("Off_hire").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Rows(i).Delete
        i = i - 1
ElseIf Cells(i, "H").Value = "On sales" Then
        Rows(i).Copy
        Sheets("On_sales").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Rows(i).Delete
        i = i - 1
End If
Next i
End If
End Sub"

excel parsing data

Saturday, January 14, 2017

Search The Matching Data Within Entire Workbook

          When the cell that to be searched is double-clicked , immediate search process is performed. Userform is loaded and  the matching cells  can be seen as page name and cell address on the userform.

 User can adapt this template to your own file. For this, follow the instructions below :
     - Open your own file
     - Press Alt+F11 keys and open VBE Window
     - In left side of VBE window, drag - drop the userform in the template to your own workbook
     - Copy the code in the ThisWorkBook field and paste it into this section of your own file.

search matching data

Monday, January 9, 2017

Employee Database With Images

         In the template, the employee information is entered into columns in the first sheet.On the other sheet,the recorded entries can be displayed in rows (vertically) in a column .
         We added a listbox, textbox, spinbutton to the report sheet. When this page is active, the names of the employees  are populated to listbox :
"lrow = Sheets("Data").Range("B" & Rows.Count).End(xlUp).Row
  ListBox1.List = Sheets("Data").Range("B2:B" & lrow).Value “


          If item of listbox is clicked, the employee's informations are displayed on rows in the sheet (e.g employee’s image,staff no, job title, date of employment).With spinbutton can be navigated between items of the listbox ,any value can be searched with textbox.

Thursday, January 5, 2017

Creating Table Of Contents

       
         If Excel workbook contains many sheets , a table of contents can be created to navigate easier between the sheets.
         This process can be done with macro .
This macro will create a new sheet at the start of the workbook named "Workbook_Index" when workbook opened. If this sheet already exists it will remove it and will rebuild. The macro will then list the names of all the sheets in the workbook and insert a hyperlink for each one.Also,can be returned to table of contents when the "Esc" key is pressed while on any sheet.
         The VBA code is displayed below. Copy and paste codes into the module of a workbook where you need to create a table of contents. 
Fort this ;
-Press Alt+F11 keys on any sheet to open Visual Basic Editor (VBE).
-Right-click on your workbook name in the "Project-VBAProject" pane (at the top left corner of the editor window) and select Insert -> Module from the context menu.
-Copy the VBA code below and paste it to the right pane of the VBA editor ("Module1" window).
-Confirm the changes , close the workbook and reopen it.

Macro code to add into module :
Sub auto_open()
Call create_index
Call return_index
End Sub
Sub Index_page()
    Sheets("Workbook_Index").Activate
End Sub
Sub create_index()
Dim Page As Worksheet
Dim k, m As Integer
k = 1
m = 1
NewSheet ("Workbook_Index")
For Each Page In Worksheets
Sheets("Workbook_Index").Cells(k, 2).Select
Sheets("Workbook_Index").Cells(k, 1).Value = m & "-"

ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=Page.Name & "!A1", TextToDisplay:=Page.Name
k = k + 1
m = m + 1
Next Page
With Sheets("Workbook_Index")
.Columns(1).Interior.Color = RGB(215, 250, 198)
.Cells.RowHeight = 18
.Columns(1).Cells.HorizontalAlignment = xlHAlignRight
.Columns(2).Cells.HorizontalAlignment = xlHAlignLeft
.Columns(2).Interior.Color = RGB(255, 255, 163)
.Columns(1).EntireColumn.AutoFit
.Columns(2).EntireColumn.AutoFit
End With
End Sub
Function NewSheet(argCreateList)
    For Each Worksheet In ThisWorkbook.Worksheets
        If argCreateList = Worksheet.Name Then
             Application.DisplayAlerts = False
            Worksheet.Delete       ' if found - delete it
           
        End If
    Next Worksheet
    Worksheets.Add(Before:=Worksheets(1)).Name = argCreateList
End Function
Sub return_index()
Application.OnKey "{ESC}", "Index_page"
End Sub

excel table of contents

Wednesday, January 4, 2017

Excel Convert HEX To RGB

          Hexadecimal(Hex) color codes frequently are used in web designing (HTML-CSS etc.) .
In Excel, the RGB and HLS color codes  are used. Therefore, it is necessary to convert Hex values to RGB or HLS.
          For example,consider we have a hexadecimal code for a cell background color in Excel ; #FF8800 . This code corresponds to orange color.When we convert this code to rgb with userform that we created, the result is RGB(255,136,0). So, we can use the color code as Rgb in Excel and Vba.
For example : "Sheets("Page-1").Range("f11").Interior.Color = RGB(255, 136, 0)
                       TextBox1.BackColor = RGB(255, 136, 0)"

convert hex to rgb

Monday, January 2, 2017

Creating A Separate Sheet For Each Month With Macro


           When button is clicked, new sheets (12 sheets) are created for each month and added in workbook.
Namely months of the current year are ordered as pages.

Days of each month are listed in Column A as "dd.mm.yyyy". Today's date is selected from between dates.


creating month sheet macro