Excel VBA AutoFit Method

Setting  The Width Of Columns According To The Cell Content


          The Life-Saving Excel Feature You Probably Didn’t Notice.

By this code, Excel automatically adjusts the width of a column to accommodate the width of the text that takes up the most horizantal space in each row :
For this , we added that VBA codes to Data sheet Worksheet_Change procedure:
Columns(Target.Column).AutoFit




Read more ...

Excel VBA Create A Picture From Cells

Creating Image From Selected Cells And Saving

        An image is created  from the selected cell or cells. The generated images are saved to the in the same  location with workbook.

Image names are checked and each recorded image is saved with a different name.
For example : myimage1.jpg, myimage2.jpg


Codes that provide us to build the image:
Sub CopyRangeToJpg()
    Dim rng As Excel.Range
    Dim cht As Excel.ChartObject
    Dim alan As String
    Dim i As Long
   Dim strPath As String
   strPath = ThisWorkbook.Path & "\"
       Application.ScreenUpdating = False
    alan = Selection.Address
    For i = 1 To 1
        Set rng = Sheets(i).Range(alan)
        rng.CopyPicture xlScreen, xlPicture
        Set cht = Sheets(i).ChartObjects.Add(0, 0, rng.Width + 10, rng.Height + 10)
        cht.Chart.Paste
        cht.Chart.Export DosyaKontrolu(strPath, "myimage", ".jpg", i)
        cht.Delete
ExitProc:
        Application.ScreenUpdating = True
        Set cht = Nothing
        Set rng = Nothing
    Next
End Sub


The following function is used to check the image name and save the image with a different name:


Private Function DosyaKontrolu(DosyaYolu As String, DosyaOnEk As String, DosyaUzanti As String, Sayi As Long) As String
    Dim fso As Object
    Dim Kontrol As Boolean
    Dim TamDosyaYolu As String
    Set fso = CreateObject("Scripting.FileSystemObject")
    With fso
        Do
          TamDosyaYolu = DosyaYolu & DosyaOnEk & Sayi & DosyaUzanti
           Kontrol = fso.FileExists(TamDosyaYolu)
           Sayi = Sayi + 1
        Loop Until Not Kontrol
        DosyaKontrolu = TamDosyaYolu
    End With
    Set fso = Nothing
End Function




myimage1.jpg



Read more ...

Excel VBA Listbox Selection Types And Copying The Selected Data

Copy /Transfer Selected Rows Of Multiselect And Multi Column Listbox To Range Of Cells On Sheet 



Excel VBA listbox selection types :
Single Item Selecting
     VBA code to select single item :        ListBox2.MultiSelect = 0  


 Multiple Items Selecting
      VBA code to select multiple item :    ListBox2.MultiSelect = 1  
➤ Multiple Selection By Pressing  keys
      VBA code to select multiple item by pressing Ctrl and Shift keys :   ListBox2.MultiSelect = 2  

   

Read more ...

Excel VBA Frame ControlEffect

Frame Lengthening And Shortening Effect With Buttons


The loops were used  purpose of lengthening / shortening frame ,stopping operation.


VBA codes of "Extend" button :
Private Sub CommandButton1_Click()
Dim i As Double
Cancel = False
i = Frame1.Height
    Do
        i = i + 0.015
        Frame1.Height = i
             If Cancel Then
                Exit Do
            End If
     DoEvents
        Loop Until Frame1.Height >= 276
End Sub


Read more ...

Simple Userform With Picture

Excel Simple Userform With Picture


          Userform that contained to display pictures with the next and previous record  buttons.
Important point is that ,names of the pictures with names of people in column A are same.
The picture with the same name as the value entered in the name texbox control (txtFirstName) is searched in the folder.

Codes to check the presence of the image in the folder:
With Cells(currentrow, 1)
txtFirstName.Text = Cells(currentrow, 1).Value
Set NameFound = .Find(txtFirstName.Text)

With NameFound
On Error Resume Next
imgData.Picture = LoadPicture(fPath & "nopic.jpg")
imgData.Picture = LoadPicture(fPath & txtFirstName.Text & ".jpg")
End With
End With

If recording don't have a picture ,"No Picture" (nopic.jpg) is displayed.



Read more ...

Price Quote Template

Price Quote Form Containing Image

          When product code is selected from combo boxes in Column B , product description, product image and product price are automatically assigned to the relevant cells.

I did not use Vba Codes in this template.Only I used formulas.



To delete data,  only  "-" you need to add into cell in column B.


Read more ...

Excel VBA Game

To Reveal Colors Or Couples 

        Reveal colors or couples, to find pairs with as few tries as possible.Double click with  your mouse to reveal colors or couples within the black cell

Once found, pairs stay visible!

Level of the game can be selected with Level toolbar.So that ,new rows and columns  can be added to game.




Read more ...

Searching Across Worksheets

Searching In Workbook's Sheets


         » In this example, the entered value into A2 cell (name) is searched in the workbook sheets .

The found values are reported with its addresses  in "Search Page".
The "names" are in column 3 of the pages.That's why the searching took place in column 3 . The codes are created accordingly :

If aranan = Cells(y, 3) Then
s1.Cells(e, 1) = Sheets(a).Name
s1.Cells(e, 2) = Cells(y, 3).Address
s1.Cells(e, 3) = Cells(y, 1)
s1.Cells(e, 4) = Cells(y, 2)
s1.Cells(e, 5) = Cells(y, 3)
s1.Cells(e, 6) = Cells(y, 4)
s1.Cells(e, 7) = Cells(y, 5)
End If



Read more ...

Excel VBA Backup Workbook

Useful Macros - 9

Workbook Backup With VBA


         When the button is pressed, the workbook is copied to Documents folder . The copied backup workbook is named as "Backup mm-dd-yy hh-mm.xls".

 💡Our procedure:
Sub date_backup()
Dim zaman, isim As String
zaman = Application.Text(Now(), "mm-dd-yy hh-mm")
isim = "Backup" & zaman & ".XLS"
ActiveWorkbook.SaveCopyAs isim
End Sub


       We added a button to the page to run the backup macro, but if desired, the date_backup macro can be run from the Macro Window opened by pressing  Alt + F8  keys.



Read more ...

Excel Star Effect

Star Effect In Sheet

         Really a funny Excel effect . 
If the button is pressed , the sheet is populated with colorful stars.

excel effect


Read more ...

Advanced Filtering With Userform

The Items Filtering Based On Dates (First-Last Date)



Ago ,the products  are filled  with unique items into combobox and sorted alfabetically.

       When the dates (first date,last date) are entered in text boxes and if report button is pressed  the userform elongation effect is activated and listbox appears. Products can be filtered on listbox.
Dim tarih1, tarih2 As Date: Dim ara As Range, LastRow As Long
    Dim s1 As Worksheet
    Application.ScreenUpdating = False
    Set s1 = Worksheets("Sayfa1")
    If TextBox1.Value = "" Or TextBox2.Value = "" Then
    MsgBox "Please Enter Date", vbDefaultButton1
    Exit Sub
    End If
    If ComboBox1.Value = "" Then
    MsgBox "Please Choose Product", vbDefaultButton1
    Exit Sub
    End If
    tarih1 = VBA.Format(TextBox1.Value, "dd.mm.yyyy")
    tarih2 = VBA.Format(TextBox2.Value, "dd.mm.yyyy")
 
    ListBox1.Clear
    ListBox1.ColumnCount = 9
    ListBox1.ColumnWidths = "30;170;40;70;60;90;110;50;100"
 
    LastRow = s1.Range("B" & Rows.Count).End(xlUp).Row
    For Each ara In s1.Range("B2:B" & LastRow)
    If CLng(CDate(ara.Value)) >= CLng(CDate(tarih1)) And _
    CLng(CDate(ara.Value)) <= CLng(CDate(tarih2)) And _
    CStr(ara.Offset(0, 1).Value) = CStr(ComboBox1.Text) Then
ListBox1.AddItem
            ListBox1.List(ListBox1.ListCount - 1, 1) = ara
            ListBox1.List(ListBox1.ListCount - 1, 0) = ara.Offset(0, -1)
            ListBox1.List(ListBox1.ListCount - 1, 1) = ara.Offset(0, 1)
            ListBox1.List(ListBox1.ListCount - 1, 2) = ara.Offset(0, 2)
            ListBox1.List(ListBox1.ListCount - 1, 3) = ara.Offset(0, 3)
            ListBox1.List(ListBox1.ListCount - 1, 4) = VBA.Format(ara.Offset(0, 4), "#,##.00")
            ListBox1.List(ListBox1.ListCount - 1, 5) = ara.Offset(0, 5)
            ListBox1.List(ListBox1.ListCount - 1, 6) = VBA.Format(ara.Offset(0, 6), "#,##.00")
            ListBox1.List(ListBox1.ListCount - 1, 7) = ara.Offset(0, 7)
            ListBox1.List(ListBox1.ListCount - 1, 8) = ara.Offset(0, 8)
         
        End If
 Next ara
 Call uzat
 Application.ScreenUpdating = True

The date userform is used  to enter date automatically into text boxes.


Before listing the filtered data in the listbox, the userform elongation effect increases the height of the userform and the listbox appears.




Read more ...

Option Buttons Usage In Excel Userform

Using Option Button Controls In Excel Userform -Flight Information Registration Form


         📔This userform is prepared for recording the flight stats.
There are a lot of option buttons (form control) in this userform. Option buttons are activated or not activated depending on the situation.

Also the date userform is used , to enter date automatically into text boxes.



Read more ...

Useful Macros - 8 : Automatic Data Transmission Between Sheets

Automatic Data Transmission Between Sheets Of Workbook

 A great excel data copying example.     
 The entered values into  the range A1: R4000 of Sheet1 are automatically copied to other sheets of the workbook.

 We added to copy the following VBA codes to Worksheet_Change method of Sheet1:
Private Sub Worksheet_Change(ByVal Target As Range)
    Worksheets.FillAcrossSheets (Worksheets("Sheet1").Range("A1:R4000"))
End Sub




Read more ...

Userform With Scrollbar

Using VBA Scrollbar & Slider Control To Select Listbox Items


      

       excel userform scrollbar slider

excel userform

Read more ...

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