ListBox Column Adding – Deleting

In The ListBox  Column Adding – Deleting |  Listbox Column Management

       Before in this template,we fill data   to the listbox from a page with the following codes :

ListBox1.ColumnWidths = "92;140;110;65;65;35;40;65;65;115;150;65"
ListBox1.ColumnCount = 12
ListBox1.List = Sheets("Data").Range("A2:L" & [A65536].End(3).Row).Value

    After ,  those columns that we choose   can be removed  with check boxes. It does not affect the data on this page.

Example codes of checkbox1 :

Private Sub CheckBox1_Click()
Application.ScreenUpdating = False
If CheckBox1.Value = True Then
For sat = 2 To Cells(65536, 1).End(xlUp).row
ListBox1.AddItem
ListBox1.List(s, 0) = Cells(sat, 1)
s = s + 1
Next
     Else
For i = 0 To ListBox1.ListCount - 1
        ListBox1.column(0, i) = Empty
     Next i
End If
Application.ScreenUpdating = True
End Sub




Read more ...

Excel Mouse Move Event

Mouse Move Event On Textbox
When the mouse over textbox on userform, font and background of the textbox is changing.



Read more ...

Converting Date To Month And Year

Convert Date To Month And Year With VBA


           The entered date in column C is transfered as months and years into column A and column B.
Rows are colored differently for each month.



Our macro codes :
If Intersect(Target, [C2:C65536]) Is Nothing Then Exit Sub
Target.Offset(0, -2).Value = Format(Target, "mm")
Target.Offset(0, -1).Value = Format(Target, "yyyy")
Target1 = Target.Offset(0, -2)
If Target1 = 1 Then
Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = 39
Range("A" & Target.Row & ":C" & Target.Row).Borders.LineStyle = 1
End If
If Target1 = 2 Then
Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = 36
Range("A" & Target.Row & ":C" & Target.Row).Borders.LineStyle = 1
End If
If Target1 = 3 Then
Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = 45
Range("A" & Target.Row & ":C" & Target.Row).Borders.LineStyle = 1
End If
If Target1 = 4 Then
Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = 12
Range("A" & Target.Row & ":C" & Target.Row).Borders.LineStyle = 1
End If
If Target1 = 5 Then
Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = 16
Range("A" & Target.Row & ":C" & Target.Row).Borders.LineStyle = 1
End If
If Target1 = 6 Then
Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = 17
Range("A" & Target.Row & ":C" & Target.Row).Borders.LineStyle = 1
End If
If Target1 = 7 Then
Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = 43
Range("A" & Target.Row & ":C" & Target.Row).Borders.LineStyle = 1
End If
If Target1 = 8 Then
Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = 20
Range("A" & Target.Row & ":C" & Target.Row).Borders.LineStyle = 1
End If
If Target1 = 9 Then
Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = 22
Range("A" & Target.Row & ":C" & Target.Row).Borders.LineStyle = 1
End If
If Target1 = 10 Then
Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = 33
Range("A" & Target.Row & ":C" & Target.Row).Borders.LineStyle = 1
End If
If Target1 = 11 Then
Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = 27
Range("A" & Target.Row & ":C" & Target.Row).Borders.LineStyle = 1
End If
If Target1 = 12 Then
Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = 40
Range("A" & Target.Row & ":C" & Target.Row).Borders.LineStyle = 1
End If
If Target1 = "" Then
Range("A" & Target.Row & ":C" & Target.Row).Interior.ColorIndex = 0
Range("A" & Target.Row & ":C" & Target.Row).Borders.LineStyle = 0
End If



Read more ...

Label Management On Userform

Label Management On Userform With Buttons

         In this template ; font color, background color, font size, frame type etc. of label on the 
UserForm,with the spin buttons and buttons are set.



Read more ...

Filling Data Automatically In Cells

Fill Data Automatically In Cells With Macro

      We used  Column B and C as sample in this template . When data is written into any row of column B and column C, in these columns data are filled up to the most recently used row in sheet .


To Sheet1 Worksheet_Change procedure ,we added the following VBA codes to fill columns :
Private Sub Worksheet_Change(ByVal target As Range)
If target.Column >= 2 And target.Column <= 3 Then
Call AsagiDoldur(target)
End Sub

Sub AsagiDoldur(IslemgorenHucre As Range)
Dim Islemde As Boolean

If Islemde = False Then
Islemde = True
If Not IslemgorenHucre.Row = ActiveCell.SpecialCells(xlCellTypeLastCell).Row Then
Range(IslemgorenHucre.Address, Cells(ActiveCell.SpecialCells(xlCellTypeLastCell).Row, IslemgorenHucre.Column).Address).FillDown
End If

Islemde = False
End If
End Sub


Read more ...

Adding Button Into All Pages

Adding Button Into All Pages With Macro

       When we pressed button in the sheet1 to run macro, a button is added to all pages the same coordinates.
We assigned  for this buttons  "task of userform opening" .



Read more ...

Excel Chronometer (Stopwatch)

Excel Chronometer Example


         A nice Excel chronometer userform.
The stopwatch is running on the userform.The stopwatch can be stopped and value in screen can be saved.


VBA codes of chronometer "Start" button :
Option Explicit
Dim Durrrrr As Boolean
Dim Etime As Single
Dim Etime0 As Single
Dim Sonzaman As Single
Dim tur As Integer

Private Sub CommandButton1_Click()
Durrrrr = False
Etime0 = Timer() - Sonzaman
Me.Repaint
Do Until Durrrrr
Etime = Int((Timer() - Etime0) * 100) / 100
If Etime > Sonzaman Then
Sonzaman = Etime
ElapsedTimeLbl.Caption = Format(Etime / 86400, "hh:mm:ss.") & Format(Etime * 100 Mod 100, "00")
DoEvents
End If
Loop
End Sub


Read more ...

Excel VBA Autofilter Using UserForm

Excel VBA Autofilter Using The UserForm


         Autofilter is done using userform (with check boxes and combo boxes) in this template.
Simple and easy to understand example.



Read more ...

Excel Vertical Filtering

Excel : Ranking The Filtering Results  Into Column From Up To Down

            Unlike other templates in this template ,filtering is done with text boxes to "Filtering" sheet from "Data" sheet.
The found results are listed in "Filtering" sheet's columns E (E2:E12) and F (F2:F12).


Read more ...

Parsing Data To Sheets With Drop Down Lists

Deploy Data To Sheets According To Values (Ok Or Cancel) On A Column

           When "Run" button is clicked,  if  the value of the data in the E column is "OK" ,row is transfered to "Done" sheet , 
if  the value of the data in the E column is "Cancel" ,row is transfered to "Cancelled" sheet.

excel parsing data to sheets

          Or without pressing the button in sheet, the "Macro" window is opened by pressing Alt + F8 keys on the keyboard, the macro named "Transfer" is selected and the "Run" button in the macro window is pressed. Thus, the macro is triggered and the transfer process is performed. 

excel parsing values to sheets with drop down lists


Macro codes that ensure data transfer :
Sub Transfer()
Dim i As Long
For i = 2 To ActiveSheet.Cells(Rows.Count, "E").End(xlUp).Row
If ActiveSheet.Cells(i, "E").Value = "OK" Then
Rows(i).Copy
Sheet2.Range("A" & Sheet2.Cells(Rows.Count, "A").End(xlUp).Row).Offset(1, 0).PasteSpecial xlPasteValues
Rows(i).Delete
i = i - 1
ElseIf ActiveSheet.Cells(i, "E").Value = "Cancel" Then
Rows(i).Copy
Sheet3.Range("A" & Sheet3.Cells(Rows.Count, "A").End(xlUp).Row).Offset(1, 0).PasteSpecial xlPasteValues
Rows(i).Delete
i = i - 1
End If
Next i

For i = 2 To ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
Cells(i, "A").Value = i - 1
Next i
End Sub



Read more ...

Filtering Data By Multiple Criteria On Userform

Filtering Data By Multiple Criteria

       
          An advanced example about VBA filtering.
We can filter on userform with combo boxes according to multiple criteria in this template .
Also can be filtered between columns according to many operators (=, >, >=, <, <=) comparison.

vba filter

Codes of Filter button :
Private Sub CommandButton1_Click()
Dim strOperator1 As String, strOperator2 As String
Dim rCell As Range
With Sheet2
On Error Resume Next
.Range("CriteriaData").ClearContents
.Range("Z1:AD100").Clear

If Dand.Value = True Then
If D1.ListIndex > -1 Then .Range("B4") = "=" & """" & D1.Value & """"
If D2.ListIndex > -1 Then .Range("C4") = "=" & """" & D2.Value & """"
Else
If D1.ListIndex > -1 Then .Range("B4") = "=" & """" & D1.Value & """"
If D2.ListIndex > -1 Then .Range("B5") = "=" & """" & D2.Value & """"
End If

If Qand.Value = True Then
If Q1.ListIndex > -1 Then .Range("D4") = Q1C & Q1.Value
If Q2.ListIndex > -1 Then .Range("E4") = Q2C & Q2.Value
Else
If Q1.ListIndex > -1 Then .Range("D4") = Q1C & Q1.Value
If Q2.ListIndex > -1 Then .Range("D5") = Q2C & Q2.Value
End If

strOperator1 = UBDC1
strOperator2 = UBDC2

If strOperator1 = "=" Then strOperator1 = ""
If strOperator2 = "=" Then strOperator2 = ""

If UBDand.Value = True Then
If IsDate(UBD1) Then .Range("F4") = strOperator1 & UBD1.Value
If IsDate(UBD2) Then .Range("G4") = strOperator2 & UBD2.Value
Else
If IsDate(UBD1) Then .Range("F4") = strOperator1 & UBD1.Value
If IsDate(UBD2) Then .Range("F5") = strOperator2 & UBD2.Value
End If

If Land.Value = True Then
If L1.ListIndex > -1 Then .Range("H4") = "=" & """" & L1.Value & """"
If L2.ListIndex > -1 Then .Range("I4") = "=" & """" & L2.Value & """"
Else
If L1.ListIndex > -1 Then .Range("H4") = "=" & """" & L1.Value & """"
If L2.ListIndex > -1 Then .Range("H5") = "=" & """" & L2.Value & """"
End If

If ACand.Value = True Then
If AC1.ListIndex > -1 Then .Range("J4") = "=" & """" & AC1.Value & """"
If AC2.ListIndex > -1 Then .Range("K4") = "=" & """" & AC2.Value & """"
Else
If AC1.ListIndex > -1 Then .Range("J4") = "=" & """" & AC1.Value & """"
If AC2.ListIndex > -1 Then .Range("J5") = "=" & """" & AC2.Value & """"
End If

If WorksheetFunction.CountA(Range("FisrtRowCriteria")) > 0 Then
For Each rCell In Range("SecondRowCriteria")
If IsEmpty(rCell) And rCell.Offset(-1, 0) <> "" Then
rCell = rCell.Offset(-1, 0)
End If
Next rCell

If WorksheetFunction.CountA(Range("SecondRowCriteria")) > 0 Then
.Range(.Range("A4").End(xlToRight).Offset(-1, 0), _
.Range("L5").End(xlToLeft)).Name = "FilterCriteria"
Else
.Range(.Range("A4").End(xlToRight).Offset(-1, 0), _
.Range("L4").End(xlToLeft)).Name = "FilterCriteria"
End If

Range("Data_Table_With_Heads").AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:=Range("FilterCriteria"), CopyToRange:=.Range("Z1")
.Range("Z1").CurrentRegion.Offset(1, 0).Name = "Filtered_Data"
ListBox2.RowSource = ""
ListBox2.RowSource = "Filtered_Data"
End If
End With

On Error GoTo 0
End Sub



Read more ...