Tuesday, November 29, 2016

Fast Date Entry To Active Cell With Right-Click Menu

Userform To Insert Date (Alternative To Date Picker and Calendar Control)

       
         With the userform that we created, data can be easily entered into the active cell.
When the user right-clicks on the active cell, the userform is opened. The userform contains three combo boxes (for month,day,year).

          The date selected from the combo boxes is displayed as short date (dd.mm.yyyy) in the textbox. The day name for the date is reported in the label control on textbox's right ; sunday,monday etc. Related codes :
"TextBox1 = VBA.Format(DateSerial(VBA.CLng(Me.cboYear.Value), Me.cboMonth.ListIndex + 1, Me.cboDay.Value))
Label1.Caption = WeekdayName(Weekday(TextBox1, 0), False, 0)
.."
           When the button is pressed, the selected date is entered into the cell and userform closes.

Userform To Insert Date -Alternative To Date Picker and Calendar Control

Thursday, November 24, 2016

Embedding Flash File (.swf) In Excel Sheet

Insert SWF Flash File Into Excel

         
           You may need to play the flash file -.swf - (such as game, animation, picture gallery) in excel sheet. To embed flash file to excel ;

In Excel 2003 version :
- From the 'View' menu , select 'Toolbars'
- On the 'Control Toolbox' toolbar, click on the 'More controls' icon (at bottom left)
- List of controls are displayed here.
- Scroll down until you find the 'Shockwave Flash Object' and click on it.
- With the "+" icon that appeared, draw a frame that the flash will be played in .
- On the 'Control Toolbox' toolbar, click on the 'Properties' icon (at top right) Set the necessary      settings in the properties window. These settings:
  • Autoload = True
  • EmbedMovie = True
  • Enabled = True
  • Loop = True
  • Playing = True
  • Visible = True
  • Movie = c:\flash.swf (Change this to the location of your .swf file)
- Close the 'Properties' control.
- Save Excel Sheet.
- Reopen the sheet.

In Excel 2007-2010 -2013 version :
Add “Developer” tab into Excel menu bar. Click "Microsoft Office Button" on the top left and click “Excel  Options”,    then choose “Show Developer tab in the Ribbon” and click "Ok".
- Import “Shockwave Flash Object” to Excel . Go to "Developer" > "Insert" > “Form  Controls” > "More Controls" window and select “Shockwave Flash Object” to add a control square inside to worksheet.  Then you can use your mouse to drag and resize the control(View the sample below)
- Right click the square and choose “Properties” to the Properties dialog box. Then you need to do some settings for your animation movie like this:

  • Autoload = True
  • EmbedMovie = True
  • Enabled = True
  • Loop = True
  • Playing = True  (if you want your flash files play automatically when open Excel sheet)
  • Visible = True
  • Movie = c:\flash.swf (Change this to the location of your .swf file)
Especially ,the funny games that you added excel sheet can be played  as offline. For example ,I embedded chess game, piano ,drums instrument to example workbook.

insert flash file into excel

Wednesday, November 23, 2016

Excel Vba Remove Duplicates

Excel Vba Remove Duplicate Values In Row With Loop
         The duplicate values in the column can be deleted with a simple loop. For example, column A was taken as the basis in this template. The used loop's codes :
"Sub remove()
Dim a As Long
For a = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("A1:A" & a), Cells(a, 1)) > 1 Then Rows(a).Delete
Next
End Sub "

Excel Vba Remove Duplicate Values In A Row

Tuesday, November 22, 2016

New Updated Userform : 15 Column & More Faster Search Method

Excel Advanced Userform & More Faster Data Searching Method

     
             In this template,we have edited the listbox in userform as 15 columns. We changed the data search method to get faster results and used “Autofilter Method”. Related codes :
"Select Case ComboBox1.Value
Case "First Name"
ActiveSheet.AutoFilterMode = False
ListBox1.Clear
ActiveSheet.Range("A1:O" & Sheets("Data").Cells(Rows.count, 1).End(xlUp).Row).AutoFilter Field:=1, Criteria1:=TextBox13.Value & "*", Operator:=xlAnd
Sheets("FilteredData").Cells.Clear
..."
            Ago , the searched value is filtered on main sheet, the filtered values are copied to a hidden sheet (FilteredData Sheet), then the data on this hidden sheet are filled into the listbox :
"If ActiveSheet.Range("A1").CurrentRegion.Columns(1).SpecialCells(xlCellTypeVisible).count <= 1 Then
GoTo here:
Else
ActiveSheet.Range("A2:O" & Sheets("Data").Cells(Rows.count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
        Destination:=Sheets("FilteredData").Range("A2")
End If
Sheets("FilteredData").Columns.AutoFit
ListBox1.List = Sheets("FilteredData").Range("A2:O" & Sheets("FilteredData").Cells(Rows.count, 1).End(xlUp).Row).Value
here:
ActiveSheet.AutoFilterMode = False
Call Clear
..."
          When "Estimated Revenue" is selected as the search column from the ComboBox1, the hidden ComboBox2 is displayed. This combobox contains the operators "=", "<", ">". The value in textbox and with these operators are performed advanced filtering :
"Case "Estimated Revenue"
ActiveSheet.AutoFilterMode = False
ListBox1.Clear
Select Case ComboBox2.ListIndex
Case "0"
ActiveSheet.Range("A1:O" & Sheets("Data").Cells(Rows.count, 1).End(xlUp).Row).AutoFilter Field:=12, Criteria1:="=" & TextBox13.Value
Case "1"
ActiveSheet.Range("A1:O" & Sheets("Data").Cells(Rows.count, 1).End(xlUp).Row).AutoFilter Field:=12, Criteria1:="<" & TextBox13.Value
Case "2"
ActiveSheet.Range("A1:O" & Sheets("Data").Cells(Rows.count, 1).End(xlUp).Row).AutoFilter Field:=12, Criteria1:=">" & TextBox13.Value
End Select
..."

Listbox items can be copied to the other page using ListBox Selection Methods (single select,multiple select).

excel advanced userform

Saturday, November 19, 2016

Excel Vba Merge Multiple Sheets Into One Worksheet

Merge Multiple Sheets Into One Worksheet & Receive Subtotal


          Excel users usually need to merge multiple worksheets into a single main worksheet, so that the data can be analyzed quickly and easily.
In this template ago, we combined all sheets into one sheet :
"Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Grand_Table"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Last = FindLastRow(Sheets(1))
Selection.Copy
With Sheets(1).Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
  .PasteSpecial xlPasteValues
  .PasteSpecial xlPasteFormats
  End With
  Next 
...  "

 Later, we sorted in ascending order the data in created main sheet and received subtotal of column that we selected :
"Sheets("Grand_Table").UsedRange.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(6), _
Replace:=True, PageBreaks:=True, SummaryBelowData:=True "

 "TotalList: = Array (6)" expression in subtotal codes indicates Column 6.

We highlighted the subtotal cells by coloring them :
"For Each Rng In Selection
If Rng.HasFormula Then
With Rng
.Interior.ColorIndex = 37
.Font.Bold = True
End With
End If
Next "

Especially with this template, the months of year are merged into a single sheet, and subtotals can be received and analyzed yearly data easily.

Merge Multiple Sheets Into One Worksheet

Thursday, November 17, 2016

Excel Highlight Row And Column Of Active Cell

Excel Highlight Row And Column

          When a cell is selected in sheet , Excel highlights the row and column with shapes by creating the background color and border of the associated row and column .


excel highlight row column

Excel Animation Example

Animation In Sheet

            A good animation example made with the following Excel codes :

"Sub Animasyon13()
    ActiveSheet.Shapes("Ferman").Select
    Selection.Characters.Delete
        m = 0
    For i = 1 To 140
      Selection.ShapeRange.Width = m
      Selection.ShapeRange.Adjustments.Item(1) = k
      m = m + 1
      k = k + 1
      DoEvents
    Next i
        Selection.Characters.Text = Range("a1").Value
        With Selection.Characters(Start:=1, Length:=22).Font
        .Name = "Arial"
        .FontStyle = "Normal"
        .Size = 11
        .Bold = True
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = True
        .Shadow = True
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 12
    End With
    Range("A1").Select
End Sub "
excel animation

Tuesday, November 15, 2016

Insert Sequence Numbers Quickly With Macro

Creating Multiple Inputbox With Excel Vba          
          The sequence numbers can be added into the wished column with macro. When the button on the page is clicked, macro starts running .Input boxes  are opened in sequence.
.Input boxes ask the questions to the user.
          The sequence numbers are added to the selected column according to the answers given by the user.


Codes of input boxes :
cevap1 = InputBox("Please ,Select The Column You Want To Enter The Sequence Numbers." & vbNewLine & vbNewLine & _
"Column Numbers and Their's Letters" & vbNewLine _
& vbNewLine & "1 -> A                10 -> J                19 -> S" _
& vbNewLine & "2 -> B                11 -> K                20 -> T" _
& vbNewLine & "3 -> C                12 -> L                21 -> U" _
& vbNewLine & "4 -> D                13 -> M                22 -> V" _
& vbNewLine & "5 -> E                14 -> N                23 -> W" _
& vbNewLine & "6 -> F                15 -> O                24 -> X" _
& vbNewLine & "7 -> G                16 -> P                25 -> Y" _
& vbNewLine & "8 -> H                17 -> Q                26 -> Z" _
& vbNewLine & "9 -> I                18 -> R                ........" _
& vbNewLine & vbNewLine & "Press OK Button After Writing Your Answer .", "COLUMN", "1")

cevap2 = InputBox("Which Rows to Begin?" & vbNewLine & vbNewLine & _
"Press OK Button After Writing Your Answer .", "Row", "2")

cevap3 = InputBox("Enter The Sequence Number to Begin From Which Number." & vbNewLine & vbNewLine & _
"Press OK Button After Writing Your Answer .", "The Number Of Start", 1)

excel vba multiple inputbox

Excel Convert A Numeric Value Into English Words

Convert Numeric Value To Text


           The NumbertoText Function is used for this process. Also,  Dollars and Cents are added to last of words according to the situation.
For to add in a workbook and to use this function :
1. Open any workbook.
2. Press ALT+F11  to open the Visual Basic Application Window.
3. On the Insert menu, click Module.
4. Type the following code into the module.

Function NumbertoText(ByVal MyNumber)
    Dim Dollars, Cents, Temp As String
    Dim DecimalPlace, Count
    ReDim Place(9) As String
    Place(2) = " Thousand "
    Place(3) = " Million "
    Place(4) = " Billion "
    Place(5) = " Trillion "

    ' String representation of amount
    MyNumber = Trim(Str(MyNumber))
    ' Position of decimal place 0 if none
    DecimalPlace = InStr(MyNumber, ".")
    'Convert cents and set MyNumber to dollar amount
    If DecimalPlace > 0 Then
        Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
        MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
    End If

    Count = 1
    Do While MyNumber <> ""
       Temp = GetHundreds(Right(MyNumber, 3))
       If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
          If Len(MyNumber) > 3 Then
             MyNumber = Left(MyNumber, Len(MyNumber) - 3)
        Else
            MyNumber = ""
        End If
        Count = Count + 1
    Loop

    Select Case Dollars
        Case ""
            Dollars = "No Dollars"
        Case "One"
            Dollars = "One Dollar"
        Case Else
            Dollars = Dollars & " Dollars"
    End Select

    Select Case Cents
        Case ""
            Cents = " and No Cents"
        Case "One"
            Cents = " and One Cent"
        Case Else
            Cents = " and " & Cents & " Cents"
    End Select
    NumbertoText = Dollars & Cents
End Function

' Converts a number from 100-999 into text
Private Function GetHundreds(ByVal MyNumber)
    Dim Result As String
    If Val(MyNumber) = 0 Then Exit Function
    MyNumber = Right("000" & MyNumber, 3)

    'Convert the hundreds place
    If Mid(MyNumber, 1, 1) <> "0" Then
        Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
    End If

    'Convert the tens and ones place
    If Mid(MyNumber, 2, 1) <> "0" Then
        Result = Result & GetTens(Mid(MyNumber, 2))
    Else
        Result = Result & GetDigit(Mid(MyNumber, 3))
    End If

    GetHundreds = Result
End Function

' Converts a number from 10 to 99 into text. *
Private Function GetTens(TensText)
    Dim Result As String
    Result = ""           'null out the temporary function value
    If Val(Left(TensText, 1)) = 1 Then   ' If value between 10-19
        Select Case Val(TensText)
            Case 10: Result = "Ten"
            Case 11: Result = "Eleven"
            Case 12: Result = "Twelve"
            Case 13: Result = "Thirteen"
            Case 14: Result = "Fourteen"
            Case 15: Result = "Fifteen"
            Case 16: Result = "Sixteen"
            Case 17: Result = "Seventeen"
            Case 18: Result = "Eighteen"
            Case 19: Result = "Nineteen"
            Case Else
        End Select
      Else                                 ' If value between 20-99
        Select Case Val(Left(TensText, 1))
            Case 2: Result = "Twenty "
            Case 3: Result = "Thirty "
            Case 4: Result = "Forty "
            Case 5: Result = "Fifty "
            Case 6: Result = "Sixty "
            Case 7: Result = "Seventy "
            Case 8: Result = "Eighty "
            Case 9: Result = "Ninety "
            Case Else
        End Select
         Result = Result & GetDigit _
            (Right(TensText, 1))  'Retrieve ones place
      End If
      GetTens = Result
   End Function
' Converts a number from 1 to 9 into text.
Private Function GetDigit(Digit)
    Select Case Val(Digit)
        Case 1: GetDigit = "One"
        Case 2: GetDigit = "Two"
        Case 3: GetDigit = "Three"
        Case 4: GetDigit = "Four"
        Case 5: GetDigit = "Five"
        Case 6: GetDigit = "Six"
        Case 7: GetDigit = "Seven"
        Case 8: GetDigit = "Eight"
        Case 9: GetDigit = "Nine"
        Case Else: GetDigit = ""
    End Select
End Function "

Now activate any sheet of the workbook .For example, enter "the number 50" into cell G1, and enter the following formula into another cell:
=NumbertoText(G1)
The result will be as this : Fifty Dollars and No Cents

- If desired, the function can be adapted to the Euro by changing the Dollar words with Euro words.

          This function is particularly useful for templates such as invoice. Previously we used the function in the invoice templates:

Convert Numeric Value To Words

Thursday, November 10, 2016

Excel Add Blank Rows With Checkbox Or Button

Excel Vba Add Blank Rows

            New blank rows can be added under each row with checkbox and button . Blank rows can be deleted with the deleting button.


Used codes for checkbox :
"Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
Call Addrow
Else
Call Clr
End If
End Sub"

Sub Addrow()
Dim a As Byte
Dim c As Integer
[A1].Select
a = 2
c = 0
   While ActiveCell.Value <> ""
      c = c + 2
      ActiveSheet.Rows(c).Insert Shift:=xlDown
      ActiveCell.Offset(a, 0).Select
   Wend
  End Sub

Sub Clr()
On Error Resume Next
Range("A2").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub "

Used codes for buttons:
"Private Sub CommandButton1_Click()
Call Addrow
End Sub

Private Sub CommandButton2_Click()
Call Clr
End Sub "

excel vba add blank rows

Wednesday, November 9, 2016

Excel Sheet Adding - Deleting With Userform

Excel Vba Add Sheet - Assigning Macro To Short-Cut Key

           If "F9 key" is pressed on the any sheet, the form opens.Any sheet or sheets in workbok can be deleted and can be added new sheet to workbook with this userform.

With combobox can be navigated between sheets of the workbook. If selected any sheet from combobox ,that sheet's tab is activated .

The created codes is following to assign macro F9 key :
"Sub Auto_Open()
Application.OnKey "{F9}", "Show"
End Sub
 Sub Show()
    UserForm1.Show
End Sub"

The created codes is following to list worksheets name on listbox and combobox :
"...
Dim sayfa As Integer
    For sayfa = 1 To Sheets.Count
        ListBox1.AddItem Sheets(sayfa).Name
        ComboBox1.AddItem Sheets(sayfa).Name
    Next sayfa
....
"

excel vba add sheet

Tuesday, November 8, 2016

Excel Copy Unique Values To Other Sheet

Excel Vba Copy Unique Values

           Unique values are found with macro.
The unique values in column A are listed in column A of the other page. Template's codes:

"Sub Unlikecopy()
With Sheets("Sheet1")
    .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy Sheets("Sheet2").Range("A1")
    .ShowAllData
End With
End Sub"


excel vba copy unique values

Friday, November 4, 2016

Excel Automatically Displaying Listbox When Cell Is Selected

           When any cell is selected in column A, the hidden listbox appears.The data received from other sheet (List sheet) is sorted on the listbox.
The data selected from this listbox is easily entered into the active cell.


The used codes :
"Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
If Not Intersect(Range("A:A"), Target) Is Nothing And Target.Count = 1 And Target.Address(False, False) <> "A1" Then
If ActiveCell.Row >= 9 Then
ActiveWindow.ScrollRow = ActiveCell.Row - 8
End If
         Me.ListBox1.MultiSelect = fmMultiSelectMulti
         Me.ListBox1.List = Sheets("List").Range("A2:A" & Sheets("List").Cells(Rows.Count, 1).End(xlUp).Row).Value
      
      For i = 0 To Me.ListBox1.ListCount - 1
      If Target.Value <> Empty And Me.ListBox1.List(i, 0) = Target.Value Then
      Me.ListBox1.Selected(i) = True
      End If
      Next i
        
        Me.ListBox1.Top = Target.Top
        Me.ListBox1.Left = Target.Left + Target.Width
        Me.ListBox1.Visible = True
            Else
        Me.ListBox1.Visible = False
      
    End If
i = Empty
End Sub
Private Sub ListBox1_Change()
Dim yaz As String
    For i = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(i) = True Then
            yaz = yaz & Me.ListBox1.List(i) & " "
        End If
    Next i
    ActiveCell.Value = Trim(yaz)
End Sub "