Wednesday, December 21, 2016

Excel Flashing Cell

The Flashing Cell When Certain Condition Is Met

         In our example, if the value of cell A1 is greater than 5, this cell starts to flash. The flashing event is realized by changing the background color and font color of the cell at a particular time (firstly red then white color) .


Tuesday, December 13, 2016

Creating New Color Palette With Macro

Creating Color Palette With Vba Codes



       If you want, you can also create new hues with this color palette.
   
The codes we assign to button on the worksheet:
"
...
Public Function Execute() As Boolean
  Dim cc As TChooseColor
  Dim Ret As Long

  With cc
    .lStructSize = Len(cc)
    .hwndOwner = Application.Hwnd
    .lpCustColors = String$(64, vbNullChar)
    .flags = 0
    If RGBINIT Then .flags = .flags + CC_RGBINIT
    If FULLOPEN Then .flags = .flags + CC_FULLOPEN
    If PREVENTFULLOPEN Then .flags = .flags + CC_PREVENTFULLOPEN
    If SHOWHELP Then .flags = .flags + CC_SHOWHELP
    .rgbResult = Color
    Ret = ChooseColor(cc)
    If Ret = 0 Then
      Execute = False
    Else
      If .rgbResult > RGB(255, 255, 255) Then
        Execute = False
      Else
        Execute = True
        Selection.Interior.Color = .rgbResult
      End If
    End If
  End With
End Function

Sub ColorTime()
Call Execute
End Sub
...
"

Sunday, December 4, 2016

Excel Change Background Color of Selected Cells With Scrollbar Control On Userform

Excel Vba Change Cell's Background Color

          The userform starts as automatically when the worksheet is opened .Background color of selected cells can be changed with scrollbar control on this userform.
The scrollbar's min value is 0, the maximum value is 56.
Related codes:
"Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub ScrollBar1_Change()
TextBox1.Value = ScrollBar1.Value
Selection.Interior.ColorIndex = ScrollBar1.Value
End Sub

Private Sub UserForm_Initialize()
ScrollBar1.Min = 0
ScrollBar1.Max = 56
End Sub
"

Friday, December 2, 2016

Hide & Unhide Columns With Combobox

Displaying Selected Column From Combobox

     
            In this template, only the selected column from the combobox is displayed ,other columns are hidden.The used codes in this template :
" Private Sub CheckBox1_Click()
ActiveSheet.Cells.EntireColumn.Hidden = False
End Sub

Private Sub ComboBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.ComboBox1.DropDown
End Sub

Private Sub UserForm_Initialize()
  Dim lst_column As Integer
    lst_column = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
For j = 2 To lst_column
   ComboBox1.AddItem Split(ActiveSheet.Cells(1, j).Address, "$")(1) & " " & "-" & Cells(1, j).Value
Next j
End Sub

Private Sub ComboBox1_Change()
   Dim lst_column As Integer
lst_column = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
    For j = 2 To lst_column
    
     Columns(Split(ActiveSheet.Cells(1, j).Address, "$")(1)).EntireColumn.Hidden = True
Next j
Columns(ComboBox1.ListIndex + 2).EntireColumn.Hidden = False
End Sub"

excel hide unhide columns vba

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 "

Monday, October 31, 2016

Creating A Scrollable List In Worksheet

         
          If you have too large table in sheet, in such a table ,It is difficult to examine the table and to distinguish the results . 
          We can create a scrolling table using scrollbar control to overcome this problem. This is a great way to allow more data in a small space. When a user changes the scrollbar, the data accordingly changes.

- Before ,a scrollbar is added to the worksheet. A scrollbar to add to the sheet :

   Go to Developer Tab –> Insert –> Scroll Bar (Form Control).

   Click on Scroll Bar (Form Control) button and click anywhere on your worksheet.
   Right click on the Scroll Bar and click on ‘Format Control’. This will open a Format Control dialogue box.
   In Format Control dialogue box go to ‘Control’ tab, and make the following changes:
                 Current Value: 1
                 Minimum Value: 1
·                                 Maximum Value: (It will be created with codes in worksheet module)
                  Incremental Change: 1
                  Page Change: 10
                 Cell Link: $K$2

      -  Column headings are entered with formulas starting from cell B2 (=Data!A1, =Data!B1)
- The following formula is entered in the first cell (B3) and copied it to fill all the other cells: 
   =OFFSET(Data!A2;$K$2;0;1;1)
   OFFSET formula is dependent on cell K2.

- Following Formula is entered to cell K4 :
   =COUNTA(Data!$A:$A)-1

- Lastly following codes are entered to worksheet module in VBA Window to create dynamic  scrollbar (for scrollbar max value) :
  Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Set Target = Range("K6")
    ActiveSheet.Shapes("Scroll Bar 1").ControlFormat.Max = Target.Value
  End Sub

Thursday, October 27, 2016

Excel Vba Random Coloring The Duplicate Values

         
             Sample workbook contains two sheet and different two example macro.Dictionary Collection Object was used in each two macro - Set Evn = CreateObject("Scripting.Dictionary" -

In first example ago,the used range columns are sorted ascending according to cell A2 .Used codes :

"ActiveSheet.Cells(2, Cells(Rows.Count, lst_column).End(xlUp).Row).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom "

Later duplicate values background are filled by same color (according to the desired colors) . Color index number can be selected between 1 to 56. This numbers are assigned to array :

"Colors = Array(2, 4, 6, 7, 8, 12, 15, 16, 17, 19, 20, 22, 24, 27, 28, 33, 34, 35, 36, 37, 38, 39, 42, 43, 44, 45, 46, 48)
Clr = Colors(Int((UBound(Colors) - LBound(Colors) + 1) * Rnd))"

In second example , only duplicate values' background in Column A are filled by same color . Unique value's background color doesn't change (white color).


Monday, October 17, 2016

Magnifying The Selected Cell

Excel Zoom In Cell


For to magnify the cell's view the following solution can be applied :
- The font size of selected cell can be changed with macro.
  
- This macro that added to the worksheet module, looks at the currently selected cell and increases its font size.
 " Zoom_In = 1.75"

- Later the value of the cell is displayed on the shape.
   "sel.CopyPicture Appearance:=xlScreen, Format:=xlPicture      'Create zoom picture
    ActiveSheet.Pictures.Paste.Select
        With Selection
        .Name = "Zoom_Cells"
        With .ShapeRange
            .ScaleWidth Zoom_In, msoFalse, msoScaleFromTopLeft
            .ScaleHeight Zoom_In, msoFalse, msoScaleFromTopLeft
            With .Fill
                .ForeColor.SchemeColor = 44
                .Visible = msoTrue
                .Solid
                .Transparency = 0
            End With
        End With
    End With"

Wednesday, October 12, 2016

Excel Vba Column Hiding-Unhiding With Horizontal Form – 2

          In the previous template, we were finding the last used column according to the first row of columns. The used code that to find last used column : 

"lst_column = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column"

          Any value in the first row may not always be . Values may be in bottom rows.Therefore, we created the following code to find last used column in this template :

"lst_column = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column"


Tuesday, October 11, 2016

Excel Yatay Userform İle Sutun Yönetimi (Gizleme - Gösterme)

                Özellikle çok sutunlu dosyalarda çalışmak sutun sayısının fazlalığından dolayı güç olabilir . Çünkü bütün sutunlardaki bilgileri görebilmek için sayfayı devamlı sağa doğru kaydırmak zorundasınızdır.Bu sutunlardan bazılarını önemli görmez ve kapatmak isteyebilirsiniz.

Bu amaçla Excel 'de jstenmeyen sutunları gizleme-gizleneni gösterme amacı ile bir çalışma yaptık. 

Dosya açılışında sayfadaki kullanılan sutun sayısı kadar checkbox otomatik olarak oluşturulur ve yatay olarak yanyana sıralanır. Bu checkbox denetimleri sayesinde istediğiniz sutunu gizleyebilir yada görüntüleyebilirsiniz.

Bu formu kendi çalışmalarınıza da rahatlıkla ekleyebilirsiniz.

 İlgili video da bunun yolu da gösterilmektedir.


Monday, October 10, 2016

Excel Dynamically Adding Controls To Userform - Task Assignment To Controls

           In this tutorial , check boxes are automatically created based on the used column count when userform opens. The created check boxes are sorted horizontally at regular intervals :

"lst_column = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To 1                                   'Creating check boxes
For j = 1 To lst_column
    Set chkBox = Frm_Controls.Controls.Add("Forms.CheckBox.1", "CheckBox" & j)
    With chkBox
        .Top = i * 18
        .Left = (j * 70) - 65
        .BackColor = vbGreen
        .Font.Size = 11
        .Caption = Split(ActiveSheet.Cells(1, j).Address, "$")(1) & " " & "-" & Cells(1, j).Value
    End With
    chkbx_width = (lst_column * 70) + 15
    'MsgBox chkbx_width
    If chkbx_width > Me.InsideWidth Then
    With Me
    .ScrollBars = fmScrollBarsHorizontal           'This will create a horizantal scrollbar
    .ScrollWidth = chkbx_width + 50
     End With
     Else
     Me.ScrollBars = fmScrollBarsNone
     End If
Next j
Next i
.."



Check boxes are rearranged (they are removed and recreated) depending on the selected worksheet from the drop-down list :

"For Each ctl In Frm_Controls.Controls                    'Removing old check boxes
        If TypeName(ctl) = "CheckBox" Then
            Frm_Controls.Controls.Remove ctl.Name
        End If
    Next ctl
.."

Column hiding-unhiding tasks are appointed to the check boxes :

"Public WithEvents fd As MSForms.CheckBox
Private Sub fd_Click()
Dim a As Integer
If fd.Value = True Then
a = Replace(fd.Name, "CheckBox", "")
Sheets(Frm_Controls.ComboBox1.Value).Cells(1, a).EntireColumn.Hidden = True
Else
a = Replace(fd.Name, "CheckBox", "")
Sheets(Frm_Controls.ComboBox1.Value).Cells(1, a).EntireColumn.Hidden = False
End If
End Sub
"
You can easily add own excel file this userform and can use it. For this :
- Close userform .
- Press Alt +F11 keys to open VBE (Visual Basic Editor) Window .
- Open your own file .
- Drag module,class and userform in this template to the part of your own files .
- Save changes and restart your file.

Friday, October 7, 2016

Excel Automated Invoice Template

Useful And Multifunctional An Invoice Example

Today's date is added automatically to date cell.Invoice number is automatically added (number is increased one) to number's cell after the prepared invoice is recorded.

When a product is selected from the drop-down lists in sheet's cells between A17-A33, Excel automatically fills the selected product's info into concerned cells (unit price ,tax).

When a customer is selected from the drop-down list in A10 cell, Excel automatically fills the customer info into concerned cells. This info :
– Customer’s name and address,
– Customer’s company name.
– Customer’s Id,

Product prices and the grand total is calculated by formulas and grand total is converted to text.

Invoices can be saved to the  selected worksheet from the userform. The wanted value can be searched in the recorded data by other UserForm.


Wednesday, October 5, 2016

Excel Vba Column Management (Hide & Unhide)

          In this template ,the userform opens automatically when workbook is opened and userform is displayed in the upper right corner of the screen.

          Sheets of workbook is added to drop-down list. Can be navigated between pages with this drop-down list.
         The used columns of sheets with column headers are listed on the listbox based on selected sheet from drop-down list. The selected columns from listbox are hidden. All items of listbox can be selected with checkbox at same time.


User can easily add own excel file this userform and can use it. For this :
- Close userform .
- Press Alt +F11 keys to open VBE (Visual Basic Editor) Window .
- Open your own file .
- Drag module and userform in this template to the part of your own files .
- Save changes and restart your file.

Sunday, October 2, 2016

Excel Animation Macro - Rotating Text

Excel Rotating Text

Shape (WordArt Text) on the worksheet turns 360 degree. Macro codes :

"...
For i = 1 To 36
    Selection.ShapeRange.IncrementRotation 10#
    DoEvents
  Next i
...
"

Wednesday, September 21, 2016

Calculating Days Between Two Dates - 2

Subtracting The Today's Date From Cell Date And Viewing Result In Cell Comment

          In this study, we have used the same template again. When the button on userform is clicked  , today's date is subtracted from the date in cell. Result can be viewed on the added comment in cell.

Example :  20.10.2017 - 21.09.2016 (Today's date) = 394 days


Tuesday, September 20, 2016

Excel Vba Calculating Days Between Two Dates

Calculating Days Between Date In Cell And Today 

            On userform ,days can be calculated until date in cell from today's date. Related codes :

"...
TextBox15.Value = DateDiff("d", Date, Cells(ActiveCell.Row, 1).Value)
If Not IsDate(Cells(ActiveCell.Row, 1)) Then
TextBox15.Value = "Incorrect Value !"
End If
...
"

Saturday, September 17, 2016

Excel Adding Item To Listbox And Combobox

Excel Vba From Textbox To Listbox & Combobox

           We conducted the processes without using the worksheet only on the userform in this sample.

With button on the userform, item can be added from textbox to combobox and to listbox .Also item in listbox can be updated and can be deleted with buton,

The listbox contains 13 column.Therefore we have used an array to fill the listbox :

"...
myarr = Array(cmbBtch.Value, txtBtchNo.Value, cmbSupCode.Value, txtSupName.Value, txtDate.Value, _
cmbItmCode.Value, txtItmName.Value, txtBox.Value, txtTara.Value, txtGwght.Value, txtTtara.Value, txtNwght.Value, txtPrice.Value)
lstStItems.ColumnCount = 13
If lstStItems.ListCount <= 0 Then
lstStItems.Column = myarr
Else
lstStItems.AddItem myarr(0)
For n = 1 To 12
lstStItems.List(lstStItems.ListCount - 1, n) = myarr(n)
Next n
...
"

With an other button ,text boxes and combo boxes can be filled with listbox selected item's value :
"
...
If lstStItems.ListIndex <> -1 Then
        With lstStItems
        cmbBtch.Value = .List(.ListIndex, 0)
        txtBtchNo.Value = .List(.ListIndex, 1)
        cmbSupCode.Value = .List(.ListIndex, 2)
        txtSupName.Value = .List(.ListIndex, 3)
        txtDate.Value = .List(.ListIndex, 4)
        cmbItmCode.Value = .List(.ListIndex, 5)
        txtItmName.Value = .List(.ListIndex, 6)
        txtBox.Value = .List(.ListIndex, 7)
        txtTara.Value = .List(.ListIndex, 8)
        txtGwght.Value = .List(.ListIndex, 9)
        txtTtara.Value = .List(.ListIndex, 10)
        txtNwght.Value = .List(.ListIndex, 11)
        txtPrice.Value = .List(.ListIndex, 12)
            
        End With
        Else
       MsgBox " Any listbox item isn't selected !", vbCritical, ""
    End If
...
"

Saturday, September 10, 2016

Excel Vba Dependent (Cascaded) Filtering With Ado

            The columns (based on column B,C,D) can be filtered as dependent with userform quickly.

The userform contains 3 textbox and 3 listbox. When any textbox is clicked ,the userform extends downwards later listbox that associated to textbox appears . 

Data in column are listed as unique and are sorted alphabetic . With text boxes,value can be searched  within the listbox with Ado Connection :
"....
 Dim s As String, con As Object
    Me.ListBox1.Clear
    DoEvents
   
Application.ScreenUpdating = False

    Set con = CreateObject("adodb.connection")
    #If VBA7 And Win64 Then
    con.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No;"""
   #Else
    con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0;HDR=No;"""
    #End If
    
    s = "select distinct f2 from [Main$A3:D" & Range("D" & Rows.Count).End(xlUp).Row & "]  where not isnull(f2)"
    If TextBox1.Text <> "" Then s = s & " and f2 like '" & VBA.UCase(LCase(TextBox1.Text)) & "%'"
        
On Error GoTo hata
    ListBox1.Column = con.Execute(s).getrows
Application.ScreenUpdating = True
...
"

In addition, the filtering is done with "AutoFilter" method within the worksheet.

Filtering results can be copied to other sheet.