Run your VBA Program Daily & Automatically!

My Client has a Query!

He wants to receive an email as a notification just before a 15 days before his employee's vacation period starts.

here is his explanation in his words : "I am thinking about a script that opens the spreadsheet once a day iterate through all the employees (about 20) then check if today's date is equal to the day that each employee will complete one year minus 15 days, and, if the result is true, send the notification. But I don't know how to implement that with code."

Here is the solution how to make this automation happened.

1. Create a workbook

2. Add Worksheet

3. Name it as Employee Manager

4. Create a Table and enter the Employees Details in line by line

5. Create a VB Program which finds the Joining Date of Employee and if it matches the criteria then It will Email you just before the vacation period starts for him/her.

6. Supposed, Employee joined on 1st Jan 2018 then on the 15th December 2018, you will receive an email about the employee and his vacations details.

7. Now, it's very normal to create process mentioned in Point 6. (If it still thought for you then don't worry... let us know, we will provide you the solution for that module too...)

Now guess, up to the point 7 everything goes according to the plan. Now, it's time to automate it!

Now suppose in the D drive, in some folder, your this workbook is placed and it isn't open even. But the Module with VB code is also there inside. You will be required to use TWO other services of Microsoft Windows for this process to automate the VB code in the module. How? Here is the process.

8. The First thing you required is to create a VB Script. yes a file with an extension of ".VBS". You have to open a Notepad and write some code and you have to save it as any name with .VBS extension. which will further create a VB Script file.

9. Now, if you click the VB script file, if everything is okay with it, then it will find the workbook, then it will find the module and then it will run the sub-procedure which will roam through each line of employee details and if your current date is 15th December 2018, then It will trigger the email procedure and will send the email to you automatically without opening the excel file. isn't its a great thing?

Following is the YouTube link to create a VBS file to trigger the sub-procedure.

Run Macro Automatically without Opening Excel File

Now the question is how can we create code to click on that VBS file automatically on each day so you don't have to do manually on each day?

10. Here is the answer, Use Windows Task Scheduler Tool. Just Target The .VBS file you have to create and configure it in such a way that it will trigger the VBS file on each day when your computer is open.

Following is the YouTube link to trigger the VBS file by Task Scheduler on daily basis.

Launch VB Script Using Task Scheduler

If you guys liked my idea then please let me know in the comment and please do like and share this article.

Thank you.

Kamal Bharakhda

Future of VBA

It's necessary to think of exactly 10 years ahead of now because it makes your actions more based on future.

well, when you are doing good something anything, the best thing you received out of it is a community of Good People. Yes, the best asset.

I met one guy on LinkedIn named Vincent ISOZ and he suggested me to provide the same VBA solution on power query. because according to him it is the future. in the next 10 years, every corporation will moving towards cloud office. Then he wrote one comment and I really felt, I should post that comment here in front of you guys, because if VBA is the tree then we are the leaves of it.

well here is his comment...

"I also worked for Microsoft as an external consultant during 4 years. VBA will be stopped in 2024 (according to the roadmap I saw but you can probably add the 3 usual years of delay) as only Office Online will still be maintained (cloud strategy of Microsoft). We already know that the replacement of VBA is Power Query (with the M language) or JavaScript with JQuery (that's one of the reasons why Office 2019 allows you to create functions in JavaScript instead of in VBA).

And almost nobody will write VBA anymore as only JavaScript Excel functions will be supported on Mac, Windows, and Online.

Microsoft is moving everything to the web using mainly Typescript that is compiled in JavaScript and powered by Electron.

But the future will tell us what will really happen (the roadmap change many times). We will speak again about this in 2024+3 = 2027. See ya!" - Vincent ISOZ

Lol, his comment stunned me. I do have lots of argument with him thereafter but the may the best commenter win the argument. 

But I know he didn't opposed the VBA Idea but he advocated him self for the upcoming demands from the industry. So he literally asked us,

are we ready to supply over demands?

Let's discuss this....

Import XML Data in Excel Using VBA

Here is the complete VBA code to import XML Data into the Excel Workbook in a completely dynamic approach. Look at the following video.

Following is the VBA Code

Sub Impor_XML_Data()
    
    'Code By Kamal Bharkahda
    Application.ScreenUpdating = False
    Dim TargetSheet As Worksheet
    Dim ChooseFIle As Variant
    Dim TargetSheetName As String
    Dim TargetCellAddress As String
    
    TargetSheetName = Application.InputBox("Write a Sheet Name where you want to place the XML Data ***Case Sensitive***", "Target Sheet Name")

    TargetCellAddress = Application.InputBox("Write a Cell Address from where XML Data Start Placing", "Target Cell Address")
    
    
    Set TargetSheet = ThisWorkbook.Sheets(TargetSheetName)
    TargetSheet.UsedRange.Clear
    
    ChooseFIle = Application.GetOpenFilename("XML File (*.xml), *.xml", , "Kamal Bharakhda", , False)
    
    If ChooseFIle = vbNullString Then Exit Sub
    
    ThisWorkbook.XmlImport Url:=ChooseFIle, ImportMap:=Nothing, Overwrite:=True, Destination:=TargetSheet.Range(TargetCellAddress)
    
    MsgBox "Import Done"
    
    Set TargetSheet = Nothing
    Application.ScreenUpdating = True
    
End Sub

Import CSV Data into the Worksheet!

Hello Friends! Merry Christmas to all of you and to your friends and family.

Let me share a Christmas present for you all.

Do you want to import CSV file into the sheet and calculate the sum of the column data into the last row?

Well here is the file! and video of the file is in the comment box. Let me know if you guys have any queries.

Thank you. and enjoy your beautiful festival season.

Regards,
Kamal.

Sub ImportCSVFile()

    'By Kamal Bharakhda @ 919328093207 [E] kamal.9328093207@gmail.com
    Application.ScreenUpdating = False
    Dim xFileName As Variant
    Dim TargetSheet As Worksheet
    Dim Rg As Range
    Dim xAddress As String
    Dim TargetRange As Range
    
    Set TargetSheet = Sheets("DATABASE")
    TargetSheet.UsedRange.Clear
    xFileName = Application.GetOpenFilename("CSV File (*.csv), *.csv", , "Kamal Bharakhda", , False)
    
    If xFileName = False Then Exit Sub
     On Error Resume Next
    Set Rg = TargetSheet.Range("A1")
    On Error GoTo 0
    If Rg Is Nothing Then Exit Sub
    xAddress = Rg.Address
    With ActiveSheet.QueryTables.Add("TEXT;" & xFileName, Range(xAddress))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 936
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    
    Set TargetRange = TargetSheet.Range("A:A")
    
    'Splitting the Delimited Strings
    TargetRange.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
    True
    
    With TargetSheet
        Dim TotalRow As Long
        TotalRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Cells(TotalRow + 1, 3).Value = "Sub Total"
        .Cells(TotalRow + 1, 4).Value = Application.WorksheetFunction.Sum(.Range("D2:D" & TotalRow))
        With .Rows(TotalRow + 1).Font
            .Bold = True
            .Size = 13
        End With
        .UsedRange.Columns.AutoFit
    End With
    
    MsgBox "Process Done", vbInformation, "Message from Kamal"
    
    Application.ScreenUpdating = True
End Sub

IST (Indian Standard Time) to EST (Eastern Standard Time) Zone in Excel VBA.

Use the following function to get IST Date Time Values of the cell value into EST Date-Time Value. Paste the following VBA code into Module and that's it!

'/-----------------
Function IST_to_EST(ByRef SelectRange As Range) As Date
    
    ESTValue = SelectRange.Value - (0.0416667 * 10.5)
    IST_to_EST = ESTValue

End Function
'/-----------------

See this video to get more idea on this. Please comment if you have any query.

Delete Row from the Table when you have multiple tables on the same sheet

My client has query was to delete a row from the table. It sounds easy. But when the same sheet has more than two tables starting from the same row (defiantly from the different columns) it's a bit tricky to delete only a row from the Specific table.

let's say in the same worksheet You have Table1 and Table2 and you want to delete a row from table 1 dynamically by just selecting a cell inside the table range that's how my client wants to remove a row.

I prepared the workbook to show the demo to delete a row of specific table range by selecting the cell inside of it.

Here is the Code :

Private Sub CommandButton1_Click()
    
    If ActiveCell.Value = vbNullString Then Exit Sub
    
    Const RestrictedRow As Byte = 1
    Const FirstColofTable1 As Long = 1
    Const LastColofTable1 As Long = 5
    Const FirstColofTable2 As Long = 7
    Const LastColofTable2 As Long = 11
    Const Table1LeftIndex As String = "A"
    Const Table1RightIndex As String = "E"
    Const Table2LeftIndex As String = "G"
    Const Table2RightIndex As String = "K"
    Dim ActiveCellRow As Long
    Dim ActiveColumn As Long
    
    ActiveCellRow = VBA.Val(ActiveCell.Row)
    ActiveColumn = VBA.Val(ActiveCell.Column)

    If ActiveCellRow = RestrictedRow Then Exit Sub 
        
    With Sheets("Sheet2")
        If FirstColofTable1 <= ActiveColumn And ActiveColumn <= LastColofTable1 Then
            Sheets("Sheet2").Range(Table1LeftIndex & ActiveCellRow & ":" & Table1RightIndex & ActiveCellRow).Delete shift:=xlUp
        ElseIf FirstColofTable2 <= ActiveColumn And ActiveColumn <= LastColofTable2 Then
            Sheets("Sheet2").Range(Table2LeftIndex & ActiveCellRow & ":" & Table2RightIndex & ActiveCellRow).Delete shift:=xlUp
        End If
    End With
    
    MsgBox "Deleted"
    
End Sub

If my input is 1,2 & 3 then result should be 1,2,3,12,13,23,123

Q. Need VBA code to get different combinations. Eg. if my input is 1 & 2 then the result should be 1,2,12.
If my input is 1, 2 & 3 then result should be 1,2,3,12,13,23,123

Input can go up to 20 digits also
Also, result 12 and 21 should treat as same
Similarly, 123 & 321 or 231 or 312 is the same.

here is the perfect dynamic solution. You can add more than 20 digits and it will still provide you with the perfect result.

Put the following code in the module and that's it. I was working on this since yesterday. :D

Using Spin Button, Hide & Show the column one by one in Excel VBA

Show and Hide Columns one by one by Spin button up to mentioned columns limits.

this is going to be the best small tool for excel users.

here is the video. and here is the code of Spin Button.

Private Const DefaltWidth As Integer = 9
Dim TargetSheetName As String
Dim TargetSheet As Worksheet
Dim FirstColNo As Integer
Dim LastColNo As Integer
Dim I As Integer

Private Sub SpinButton1_SpinDown()
    Application.ScreenUpdating = False
    'Assigning Values to the Variables
    TargetSheetName = "Sheet1"
    Set TargetSheet = Application.ThisWorkbook.Sheets(TargetSheetName)
    FirstColNo = TargetSheet.Range("A7").Value
    LastColNo = TargetSheet.Range("A9").Value
    If TargetSheet.Range("A7").Value = Empty Or TargetSheet.Range("A9").Value = Empty Then
        MsgBox "Please Set The  Column Range Limits Before You Proceed", vbCritical, "Kamal Bharakhda"
        Exit Sub
    End If
    'Code For Unhiding Columns One By One from Limit One to Last Column
    For I = LastColNo To FirstColNo Step -1
        If TargetSheet.Columns(I).ColumnWidth = 0 Then
            TargetSheet.Columns(I).ColumnWidth = DefaltWidth
            Exit For 'This is most important point if you want to show columns one by one.
        End If
    Next I
    Set TargetSheet = Nothing
    Application.ScreenUpdating = True
End Sub

Private Sub SpinButton1_SpinUp()
    Application.ScreenUpdating = False
    'Assigning Values to the Variables
    TargetSheetName = "Sheet1"
    Set TargetSheet = Application.ThisWorkbook.Sheets(TargetSheetName)
    FirstColNo = TargetSheet.Range("A7").Value
    LastColNo = TargetSheet.Range("A9").Value
    If TargetSheet.Range("A7").Value = Empty Or TargetSheet.Range("A9").Value = Empty Then
        MsgBox "Please Set The  Column Range Limits Before You Proceed", vbCritical, "Kamal Bharakhda"
        Exit Sub
    End If
    'Code For Hiding Columns One By One from Limit One to Last Column
    For I = FirstColNo To LastColNo Step 1
        If TargetSheet.Columns(I).ColumnWidth > 0 Then
            TargetSheet.Columns(I).ColumnWidth = 0
            Exit For 'This is most important point if you want to hide columns one by one.
        End If
    Next I
    Set TargetSheet = Nothing
    Application.ScreenUpdating = True
End Sub

Working With NAMED Ranges in VBA

1. The code to change the value of each cell of the name range at the same time

Sub Change_the_Value_of_Each_cell_in_Named_Range()
    Dim NameRange As Range
    Set NameRange = Range("SALES")
    Dim Eachcell As Range
    For Each Eachcell In NameRange
        Eachcell.Value = "Sales" & "2017"
    Next Eachcell
    MsgBox "Done"
End Sub

2. Let's Say You have a list of Named Range in Sheet3 where you want to change the value of each Named Range with the Same Format

Sub Change_The_Value_of_Each_Named_Range()
    Dim I As Long
    I = 2
    Dim SheetName As String
    SheetName = "Sheet3"
    Dim TargetRange As Range
    Do Until Sheets(SheetName).Cells(I, 1).Value = vbNullString
        Set TargetRange = Range(Sheets(SheetName).Cells(I, 1).Value)
        TargetRange.Value = Sheets(SheetName).Cells(I, 1).Value & VBA.Format(Sheets(SheetName).Range("B6").Value, "YYYY")
    I = I + 1
    Loop
End Sub

3. TO RENAME THE WHOLE NAMED RANGES with EXACT FORMAT

Sub Rename_The_Name_Range()

    Dim SheetName As String
    SheetName = "Sheet3"
    Dim TargetSheet As Worksheet
    Set TargetSheet = Sheets(SheetName)
    Dim TargetNamedRange As Name
    Dim CurrentName As String
    Dim Iname As String
    Dim OriginalNamePlace As Integer
    Dim HelperString As String
    For Each TargetNamedRange In ThisWorkbook.Names
        Iname = TargetNamedRange.Name
        If VBA.InStr(1, Iname, "_") = 0 Then
            CurrentName = Iname & VBA.Format(VBA.Date, "_yyyy")
            ThisWorkbook.Names(Iname).Name = CurrentName
        Else
            OriginalNamePlace = VBA.InStr(1, Iname, "_")
            HelperString = VBA.Left(Iname, OriginalNamePlace - 1)
            CurrentName = HelperString & VBA.Format(VBA.Date, "_yyyy")
            ThisWorkbook.Names(Iname).Name = CurrentName
        End If
    Next TargetNamedRange
    MsgBox "Done"
End Sub

Timer in Excel Using VBA

Gift Your self a Nice Timer in Excel Using VBA

Just Give It A Try!

Step 1: Insert an Userform

Step 2: Locate the SHOWMODAL Property of The Userform and make it FALSE

Step 3: Design the userform you as you are seeing in video or you can design your own. it's up to you.

Step 4: Inert a New Module and paste the following code into it.

Sub ()
UserForm2.Show vbModeless
End Sub

Step 5: Double Click on a button on the userform which will start the clock and paste the following code in it.

Private Sub CommandButton1_Click()
Do
DoEvents
UserForm2.Label1.Caption = VBA.Time
Loop
End Sub

Step 6: Paste the following code to close the Timer
Private Sub CommandButton2_Click()
Unload UserForm2
End Sub

Step 7: Put a Button on the Sheet and assign macro named as "Open_Timer"
and it's done! enjoy friend.

By Kamal Bharakhda

The completely dynamic way to Rename the Shapes in Excel VBA

Sub Rename_Shape()

Dim SheetName As String
SheetName = "Sheet1"

Dim WS As Worksheet
Set WS = ThisWorkbook.Sheets(SheetName)

WS.Activate

Dim Shp As Shape

Dim ShapeName As String
ShapeName = vbNullString

Dim ShapeSelected As String
Dim NewNameofShape As String

For Each Shp In WS.Shapes
ShapeName = ShapeName & " ' " & Shp.Name & " ' "
Next Shp

ShapeSelected = VBA.InputBox(ShapeName & " Please Input the Shape names in Inverted Comma", "Select Shape")

NewNameofShape = VBA.InputBox("Please enter new name of Shape you have selected", "Rename Shape")

If ShapeSelected = vbNullString Or NewNameofShape = vbNullString Then Exit Sub

WS.Shapes(ShapeSelected).Name = NewNameofShape

End Sub

Points to Remember

1. The First Inpubox will provide you the list of the Shape available in the Inverted Comma. You need to type the name in the input area which you want to rename is

2. A second input box will ask you to enter a new name.

and there you go.

Fill ComboBox based on Seach Criteria

One the best approch for this requirement is to add one textbox as search bar which provides the same result you reuired.

Here we need to focus on three things. I'm cosidering that your combobox is in the userform1
and your students data list is in the sheet1.

Now,

There are two events you need configure to perform this task.

1. UserForm_Initialize
2. TextBox1_Change

and the one sub procedure which will populate the result based on the keyword in the textbox

3. Populate_Combobox

Now

Coding for the 1 & 2 is the same

Private Sub TextBox1_Change()
Populate_Combobox
End Sub

Private Sub UserForm_Initialize()
Populate_Combobox
End Sub

Now let's see the code for the Sub Procedure

Private Sub Populate_Combobox()
Dim I As Long
I = 2
Dim LenofStr As Long
LenofStr = 0
With UserForm1
.ComboBox1.Clear
If .TextBox1.Value = vbNullString Then
Do Until Sheet1.Cells(I, 1).Value = Empty
.ComboBox1.AddItem Sheet1.Cells(I, 1).Value
I = I + 1
Loop
Else
LenofStr = VBA.Len(.TextBox1.Value)
Do Until Sheet1.Cells(I, 1).Value = Empty
If VBA.Left(VBA.UCase(Sheet1.Cells(I, 1).Value), LenofStr) = VBA.UCase(.TextBox1.Value) Then
.ComboBox1.AddItem Sheet1.Cells(I, 1).Value
End If
I = I + 1
Loop
End If
End With
End Sub

I have also attached images with this post

BOLD a Part of the Cell Value

Q:  D1=(A1&B1)...I want the result of B1 Bold when result show i.e. Biplab (A1) & Rs.12/-(B2). In Cell No. C1 there is formula =(A1&" "B1)...Now Result I want "Biplab Rs.12/-"..... Only Rs.12/- is BOLD. (Note: Length of B1 is not fixed)

Let's create a function called Bold which will make any character under the function to bold. and you can use it directly in the sheet using formula feature. 

here is the two thing.

Put the Following function in the Module

Function BOLD(ByRef Text As String) As String

Text = "!" & Text

BOLD = Text

End Function

Now Goto the Sheet and choose we will work on Worksheet_Change Event 

here is the Code. 

Private Sub Worksheet_Change(ByVal Target As Range)

Dim I As Variant

I = Target.Value

Dim A As String

Dim B As String

Dim ALEN As Integer

Dim BLEN As Integer

Dim TargetColumnNo As Integer

TargetColumnNo = 3

If Target.Column = TargetColumnNo Then

If VBA.InStr(1, I, "!") > 0 Then

A = VBA.Left(I, Application.WorksheetFunction.Find("!", I, 1) - 1)

B = VBA.Mid(I, VBA.InStr(1, I, "!") + 1, VBA.Len(I) - VBA.InStr(1, I, "!"))

ALEN = VBA.Len(A)

BLEN = VBA.Len(B)

Target.Value = A & " " & B

Target.Characters(ALEN + 2, BLEN).Font.FontStyle = "Bold"

Else

Exit Sub

End If

End If

End Sub

Now Suppose in the Sheet1 and Column 3 would be your target column then 

write the following formula and you will get the required result. 

=A1&BOLD(B1)

Thank you. 

Replace Excel's Data Validation Drop-down with Smart Userfrom Based Mini Tool

Creating Dropdown from the Validation part of the excel is very easy and very fundamental thing we should know as an Excel Enthusiastic.

When our project required the same list of things to be chosen from the single cell usually make things done with creating the drop-down list from the Data Validation Tool which is inbuilt in Excel.

Now, Sometimes you might have faced or not, but each cell of the column requires the same list of things for selection. I was usually ending up by drag down the dropdown list to the nth row which could be messy sometimes. and it even no looks cool. and you even can't put things apart from the list.

What I have done here is, You don't require a dropdown list at all. Just see the video and you will get what I have done.

The advantage of this tool is you don't need to create hundreds of dropdown in the same column when everything is available to you in just a double-click.

To compile this tool I have required following two scopes.

1. Worksheet Code
2. Userform Design and Codes

You can design the userform and it looks easy not a big deal.

Now let's move towards coding of Worksheet
======
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   
    If Target.Column = 2 Then
        LISTBOX.Show
    End If
    
End Sub
======
I have used BeforeDoubleClick Event to initiate the things.

Now, as we double click on the cell on column two, the Sheet Code will sense it and trigger the event and will force userform to appear.

More to the Second part of the coding

=====
Private Sub UserForm_Initialize()

    Application.ScreenUpdating = False
    
    Dim DB As Worksheet
    Set DB = Sheets("DATABASE")
        
    Dim I As Long
    I = 1
    
    LISTBOX.ListBox1.Clear
    
    Do Until DB.Cells(I, 2).Value = Empty
        LISTBOX.ListBox1.AddItem DB.Cells(I, 2).Value
    I = I + 1
    Loop

    Application.ScreenUpdating = True

End Sub
=====

(Above code will take each item of the list from the Place called Database Sheet where you have listed all the details over there with Heading.)

Now DOuble Click even to input userform data into the sheet which the same part of userform coding

======
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    
    With LISTBOX.ListBox1
        If .ListIndex = -1 Then Exit Sub
        ActiveCell.Value = .List(.ListIndex)
        Cells(ActiveCell.Row, ActiveCell.Column + 1).Activate
        Unload LISTBOX
    End With
    
End Sub
======

Now Coding for the Add New Button. this coding will add Item to the list.

Private Sub CommandButton1_Click()
    
    Dim I As Variant
    Dim J As Variant
    
    If ActiveCell.Column = 2 Then
        I = VBA.InputBox("Please Enter New Tail No.:", "Add New Tail No. in The Database")
        If I = vbNullString Then
            Exit Sub
        Else
            J = NewRow("DATABASE", 2)
            Sheets("DATABASE").Cells(J, 2).Value = I
            Dim DB As Worksheet
    Set DB = Sheets("DATABASE")
     
    I = 1
    
    LISTBOX.ListBox1.Clear
    
    Do Until DB.Cells(I, 2).Value = Empty
        LISTBOX.ListBox1.AddItem DB.Cells(I, 2).Value
    I = I + 1
    Loop
        End If
  end if 

end sub
======

So This is it. Please Try. and create more ways to use it in a more effective way.

Thank you

- Kamal Bharakhda

https://www.youtube.com/watch?v=hAEL7TeqOnQ

What is the formula for calculating the inclusive tax amount from a given amount?

Let's answer it with mathematical approach. You might required to use it in the formula or in VBA. This simplification will help you for sure.

Assume few variables

X = Product's Original Amount without Tax

Y = Inclusive Tax Amount (i.e. you're looking)

Z = Product's Amount with Tax or MRP or Included tax amount.

Q = Tax %

-

So basic foundation of product's final amount after tax including is like,

X + Y = Z

Now, Y = ( Q * X ) / 100

So the equation become,

X + ( Q * X ) / 100 = Z

Now solve the above equation to find the value of X

X = ( Z * 100 ) / ( Q + 100 )

And to get the value you required put this value of X back to the initial equation

X + Y = Z

{( Z * 100 ) / ( Q + 100 )} + Y = Z

Now solve for Y,

Y = ( Z * Q ) / ( Q + 100 )

So put known values of Z & Q in the above equation and you will get the required value.

Good day.

Kamal Bharakhda

4 digit PIN Style Login System

Hello Beautiful People,

Here I'm giving away the most unique way to login in excel based applications as 4 digit PIN style.

It's Fast and secured. And even with this post, you will receive the VBA Code to change the PIN No. by the authorized user.

So, What happened yesterday, my traditional login system, which has a username and password, as usual, has become more boring. I have just completed a development of an application for billing purpose and I was testing it and I felt, I should have something more fast and furious and secured way of login system. I was thinking of for the idea and suddenly my mom came to my room and asked me for my VISA debit card and she also asked me the PIN no. of the same card. But that leaves the fantastic idea on me.

I have quickly developed something very simple and sober which works exactly like what I have assumed. The user just needs to type 4 digit pin and without any control and by using of Textbox Change Event Mechanism, I get the best result out it. and it worked like a HERO!.

Now, I'm giving away the VBA code for the Userform and Module for Changing PIN No. on any time by the Authorized User.

Here are the things you need to prepare before placing of VBA Codes.

1. User form with only One TextBox and Designed it just like what you can see in the middle of the screenshot attached to this Post.

2. Place a Command Button anywhere you want and caption it as "Change PIN No."

3. Now Open the Userform and Double Click on the Textbox and put this code in it.

Private Sub TextBox1_Change()

Application.ScreenUpdating = False

Dim RealPass As Long

RealPass = THENEWGST.Sheets("REGISTRY").Range("Z1").Value

With LOGIN

If VBA.Len(.TextBox1.Value) = 4 Then

If VBA.Val(.TextBox1.Text) = VBA.Val(RealPass) Then

'Call here the next Procedure you want to execute after entering of successful PIN No. 

Else

MsgBox "Wrong PIN" & vbNewLine & vbNewLine & "Call us at 919328093207 for Any Query", vbExclamation, "Zyest Solutions"

.TextBox1.Value = vbNullString

End If

End If

End With

Application.ScreenUpdating = True

End Sub

4. Then Goto the button where you captioned it as "Change PIN No." and Put the following VBA Code in the Sub.

Private Sub PIN_CHANGING_PROCESS()

Application.ScreenUpdating = False

On Error Resume Next

Dim I As Variant

Dim J As Variant

Dim K As Variant

Dim L As Variant

L = THENEWGST.Sheets("REGISTRY").Range("Z1").Value

I = VBA.InputBox("Please Enter Your Current PIN", "PIN Changing Process")

If VBA.Val(I) = VBA.Val(L) Then

'/-------

J = VBA.InputBox("Please Enter Your NEW PIN", "PIN Changing Process")

If VBA.IsNumeric(J) = False Then

MsgBox "Only Numeric Inputs Are Allowed", vbExclamation, "Validation by Zyest Solutions"

Exit Sub

End If

If VBA.Len(J) <> 4 Then

MsgBox "Only Four [4] Digits are allowed as PIN", vbCritical, "Validation By Zyest Solutions"

Exit Sub

End If

'/-------

K = VBA.InputBox("Please Enter Your NEW PIN Again", "PIN Changing Process")

If VBA.IsNumeric(K) = False Then

MsgBox "Only Numeric Inputs Are Allowed", vbExclamation, "Validation by Zyest Solutions"

Exit Sub

End If

If VBA.Len(K) <> 4 Then

MsgBox "Only Four [4] Digits are allowed as PIN", vbCritical, "Validation By Zyest Solutions"

Exit Sub

End If

'/-------

If VBA.Val(J) = VBA.Val(K) Then

THENEWGST.Sheets("REGISTRY").Range("Z1").Value = VBA.Val(J)

MsgBox "Great! Your PIN No. is Changed!" & vbNewLine & vbNewLine & "Your New PIN No. is : " & J, vbOKOnly, "Zyest Solutions"

Else

MsgBox "PIN No. Doesn't matched, Please do it again", vbCritical, "Validation By Zyest"

End If

'/-------

Else

MsgBox "Wrong PIN No. Please Enter Correct PIN No.", vbExclamation, "Validation By Zyest Solutions"

End If

Exitit:

Application.ScreenUpdating = True

End Sub

Note: "THENEWGST" is my workbook name. So you can replace it with ThisWorkBook

So You can modify this code according to your requirements.

Enjoy it and try it. and leave your comments here. thanks.

Regards

Kamal Bharakhda

kamal.9328093207@gmail.com

+919328093207

Sheets Navigator Tool in Excel VBA

You all have that one workbook or spreadsheet, which have definitely more than 50 sheets. Which is very boring to scroll sometimes when you want to work with any random sheets more often.

There are many ways we can perform navigation through sheets. We can create the shapes to navigate there but hardly, we can only do that for a few sheets. Not for every sheet. So, here I'm coming with a permanent and handsome solution.

My Sheet Navigator

How it looks?

How it Works?

it's just initiated with pressing "Ctrl+k"

(I have selected "k" as a shortcut key.)

Select the Sheet you want to navigate to, and double-click it. Navigator takes you to that sheet and userform will be closed automatically.

Isn't easy?

Let's develop this Awesome Tool. 

Step 1: Goto the Developer Tab and click on the Record Macro. You will be asked to name the new macro which you gonna record. Now, don't require to name this macro but if you want then do it. Now, most important is that to assign a macro with the Shortcut key. As I have said, in my case I have chosen the letter "k" and you choose what you want. but remember, if you choose the active shortcut key, after this process, that earlier action will be overlapped by the current macro activities

So save the macro and goto the Developer Tab again and Stop the Recording. Now in VB Editor, you will see this module. 

Step 2: Design the Userform. 

You just need one list box! Insert the Userform and pick the list box from the toolbox and set it just like what you can see in the image. 

Step 3: Coding! 

This tool is running totally on two Events. 

1. UserForm_Initialize event 

2. Listbox ListBox_DblClick Event

Here is the Code for UserForm_Initialize event 

Private Sub UserForm_Initialize()

Application.ScreenUpdating = False

    

    Dim idp As Variant

    idp = ThisWorkBook.Name

    

    Dim Machine As Workbook

    Set Machine = Excel.Workbooks(idp)

    

    Dim sh As Worksheet

    

    For Each AllSH In Machine.Sheets

        Userfrom1.ListBox1.AddItem (sh.Name)

    Next

    

Application.ScreenUpdating = True

End Sub

Here is the Code for Listbox ListBox_DblClick Event 

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Application.ScreenUpdating = False

    

    Dim idp As Variant

    idp = THEIDP.Name

    

    Dim Machine As Workbook

    Set Machine = Excel.Workbooks(idp)

    

    With UserForm1.ListBox1

        Machine.Worksheets(.List(.ListIndex)).Activate

    End With

    

    Unload UserForm1

Application.ScreenUpdating = True

End Sub

There you go...save it and run it! EasyPeasy!!!!

Thank for trying this. 

Regards,

Kamal Bharakhda 

Userforms, TexBoxes & Condition Matching in Excel VBA

Suppose,

TextBox1.Value = 10
and
TextBox2.Value = 10

also, if you pass this following coding it gives the wrong result.

If TextBox1.value = TextBox2.value then 
    MsgBox "Yes They are Equal"
Else
    MsgBox "No, They are not Equal"
End if

You will defiantly get the second message and that is, "No, They are not Equal!"

So why does it happens? In Excel VBA, when you are dealing with Userforms, sometimes work demands an use of conditional matching criteria. Just like, IF the value of textbox1 is equal to textbox2 then do something. just like that.

So, Textboxes have always stored values entered in it as String Format. yes even if it's number or not. So, when do we matching the two textboxes based on numbers then we will surely not get the correct result.

So there are two ways to get rid of this.

1. Use Val function
2. Store the Value of TextBoxes into the Worksheet Range.

1. Use of Val Function

If Val(TextBox1.value) = Val(TextBox2.Value) then 
    MsgBox "Yes They are Equal"
Else
    MsgBox "No, They are not Equal"
End if

This time you will receive the First Message.

2. Let's look at this.

'Store the Value of Textboxes into the cell. 
Sheets("Sheet1").Range("A1").Value = TextBox1.value
Sheets("Sheet1").Range("A2").Value = TextBox2.value

If Sheets("Sheet1").Range("A1").Value = Sheets("Sheet1").Range("A2").Value then 
    MsgBox "Yes They are Equal"
Else
    MsgBox "No, They are not Equal"
End if

The result will be the same, the first one. It's because of Excel automatically recognize the DataType of the Data entered in the cell. So It will become more accurate and also solves your purpose.

These are the small things. many are knowing and many don't. Who doesn't it's for them. 

Thank you!

Kamal Bharakhda