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) .


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.
The 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


excel change background color


Hide & Unhide Columns With Combobox

Display The Selected A Column From Combobox

excel hide column

                 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

Fast Date Entry To Active Cell With Right-Click Menu

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

       
       
        When right-clicked on the active cell, context menu is opened.
We click on the "DATE FORM"  that we created via the module in the context menu.
When the date userform is opened, it will automatically appear today's date. If you wish, you can select another date with the help of the drop-down boxes to enter the cell.

        At the bottom of the userform, you can see which day the selected date corresponds to.
You can use the date form on all sheets of the workbook.

 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.
To use the date form in your own workbooks, copy and paste the module and date form.

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

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 remove duplicates


Excel Vba Remove Duplicate Values In A Row

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

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

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

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

Excel VBA 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 "

       The function can be used on all sheets 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.

Excel Convert Numeric Value To Words

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



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

Excel Sheet Adding - Deleting With Userform

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

       We created a userform and added a listbox, combobox, buttons, textbox control into the userform.
With this userform, a new sheet can be added to the workbook, the sheet can be deleted and can be navigated between sheets of the workbook .       
        If "F9" key in keyboard is pressed on the any sheet, the userform opens. Because ,we assigned a macro that it provides userform is opened for F9 key.

        Sheets of the workbook are listed on the combobox and listbox. We will use this listbox to add and delete worksheets.
With combobox can be navigated between sheets of the workbook. If selected any sheet from combobox ,that sheet's tab is activated .

The following codes provides assigning the macro to 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

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

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 "

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

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).


Magnifying The Selected Cell

Excel Zoom In Cell



          We've created a magnifying glass that magnifies the image within the worksheet. Thus,values in the selected cell or cells is displayed as 1.75 times larger.

For to magnify the cell's view the following solution can be applied :
- We have created a procedure called Zoom_Cells and assigned this procedure to the       Worksheet_SelectionChange event of Sheet1.

- With the codes that we add to the Worksheet_SelectionChange event of the Sheet1, as automatic a 1.75-fold larger image of the selected cells is created.

  Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Zoom_Cells
End Sub

Sub Zoom_Cells()
    Dim sel As Range, cell As Range, Zoom_In As Single
    Set sel = Selection
    Zoom_In = 1.75                         'Zoom rate
    
  For Each cell In Selection               'If there are blank cells in selection, shapes are deleted and ended method
        If cell.Value = Empty Then
        Call remove_picture
        GoTo here:
         Exit Sub
         End If
  Next
   
 Call remove_picture                        'Remove any existing zoom pictures
  Application.ScreenUpdating = False
    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
here:
    sel.Select
    Application.ScreenUpdating = True
    Set sel = Nothing
End Sub
Sub remove_picture()                           'Remove any existing zoom pictures
Dim k As Object
For Each k In ActiveSheet.Pictures
        If k.Name = "Zoom_Cells" Then
            k.Delete
        End If
    Next
End Sub

- When an empty cell is selected, the image is removed and the procedure is terminated.

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"


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.


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.

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.


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.

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
...
"

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


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
...
"

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
...
"

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.


Excel Vba :Copy The Listbox Items Into Closed Workbook

We have used address book template as sample in this study.

List of the listbox (or filtered items) can be copied into other closed workbook with a button.



Is pressed "copy button", sheets of the closed workbook are listed in the drop-down list. So that ,user can copy the contents of the listbox to the page it wants.


Compare Two Columns In Different Worksheets & Add Found Results

         Vba Worksheet Function : Countif

           Two columns in different worksheets were compared in this template. Found different results as entire row were copied to second worksheet. 

Also new row was highlighted (background color).

excel vba compare two columns

Our Vba codes:
Sub compare_columns()
Dim stk, msb As Worksheet
Set stk = Sheets("Page1")
Set msb = Sheets("Page2")

Application.ScreenUpdating = False
sat = (msb.Range("A" & Rows.Count).End(xlUp).Row) + 1
For i = 2 To stk.Range("A" & Rows.Count).End(xlUp).Row
    If WorksheetFunction.CountIf(msb.Range("A2:A" & msb.Range("A" & Rows.Count).End(xlUp).Row), stk.Cells(i, "A")) = 0 Then
        msb.Range("a" & sat).EntireRow.Value = stk.Range("a" & i).EntireRow.Value
        msb.Range("a" & sat).Interior.ColorIndex = 22
        sat = sat + 1
    End If
Next
Application.ScreenUpdating = True
Set stk = Nothing: Set msb = Nothing
End Sub