Form Control vs. ActiveX Control in MS Excel

Difference	ActiveX Controls	Excel Controls
Excel versions	97, 2000	5, 95, 97, 2000
Which toolbar?	Control Toolbox	Forms
Controls available	CheckBox, TextBox, CommandButton, OptionButton, ListBox, ComboBox, ToggleButton, SpinButton, ScrollBar, Label, Image	Label, GroupBox, Button, CheckBox, OptionButton, ListBox, ComboBox, ScrollBar, Spinner
Macro code storage	In the code module for the Sheet	In any standard VBA module
Macro name	Corresponds to the control name (e.g., CommandButton1_Click)	Any name you specify.
Correspond to...	UserForm controls	Dialog Sheet controls
Customization	Extensive, using the Properties box	Minimal
Respond to events	Yes	Click or Change events only

Convert Time Zone through VBA

Option Explicit
Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type
Private Type TIME_ZONE_INFORMATION
    Bias As Long
    StandardName(31) As Integer
    StandardDate As SYSTEMTIME
    StandardBias As Long
    DaylightName(31) As Integer
    DaylightDate As SYSTEMTIME
    DaylightBias As Long
End Type
Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
'Purpose     :  Converts local time to GMT.
'Inputs      :  dtLocalDate                 The local data time to return as GMT.
'Outputs     :  Returns the local time in GMT.
'Author      :  Andrew Baker
'Date        :  13/11/2002 10:16
'Notes       :
'Revisions   :
Public Function ConvertLocalToGMT(dtLocalDate As Date) As Date
    Dim lSecsDiff As Long
 
    'Get the GMT time diff
    lSecsDiff = GetLocalToGMTDifference()
    'Return the time in GMT
    ConvertLocalToGMT = DateAdd("s", -lSecsDiff, dtLocalDate)
End Function

'Purpose     :  Converts GMT time to local time.
'Inputs      :  dtLocalDate                 The GMT data time to return as local time.
'Outputs     :  Returns GMT as local time.
'Author      :  Andrew Baker
'Date        :  13/11/2002 10:16
'Notes       :
'Revisions   :
Public Function ConvertGMTToLocal(gmtTime As Date) As Date
    Dim Differerence As Long
 
    Differerence = GetLocalToGMTDifference()
    ConvertGMTToLocal = DateAdd("s", Differerence, gmtTime)
End Function

'Purpose     :  Returns the time lDiff between local and GMT (secs).
'Inputs      :  dtLocalDate                 The local data time to return as GMT.
'Outputs     :  Returns the local time in GMT.
'Author      :  Andrew Baker
'Date        :  13/11/2002 10:16
'Notes       :  A positive number indicates your ahead of GMT.
'Revisions   :
Public Function GetLocalToGMTDifference() As Long
    Const TIME_ZONE_ID_INVALID& = &HFFFFFFFF
    Const TIME_ZONE_ID_STANDARD& = 1
    Const TIME_ZONE_ID_UNKNOWN& = 0
    Const TIME_ZONE_ID_DAYLIGHT& = 2
 
    Dim tTimeZoneInf As TIME_ZONE_INFORMATION
    Dim lRet As Long
    Dim lDiff As Long
 
    'Get time zone info
    lRet = GetTimeZoneInformation(tTimeZoneInf)
 
    'Convert diff to secs
    lDiff = -tTimeZoneInf.Bias * 60
    GetLocalToGMTDifference = lDiff
 
    'Check if we are in daylight saving time.
    If lRet = TIME_ZONE_ID_DAYLIGHT& Then
        'In daylight savings, apply the bias
        If tTimeZoneInf.DaylightDate.wMonth <> 0 Then
            'if tTimeZoneInf.DaylightDate.wMonth = 0 then the daylight
            'saving time change doesn't occur
            GetLocalToGMTDifference = lDiff - tTimeZoneInf.DaylightBias * 60
        End If
    End If
End Function

Data Validation Using VBA

Please find the attachment

https://docs.google.com/file/d/0B23eJ2xd9ODyemRISnRSMmQ5LUk/edit?usp=sharing

Example of Select Case in VBA

Dim rng As Range, totalsalary As Long

Sub calculatesalary()
Set rng = Application.InputBox("Select Range", "salary", Type:=8)
For Each cell In rng
        Select Case cell.Value
        Case Is <= 900
         totalsalary = cell.Value + (cell.Value * 0.1)
        Case 901 To 1000
         totalsalary = cell.Value + (cell.Value * 0.125)
        Case Is > 1000
        totalsalary = cell.Value + (cell.Value * 0.15)
        End Select
        cell.Offset(, 1) = totalsalary
Next
End Sub

Using Enumeration In VBA

VBA code to develop a function to calculate salary with allowance



Public Enum commission
grade1 = 100
grade2 = 125
grade3 = 150
End Enum

Function Calculatesalary(ByVal rng As Range) As Long
Dim salary, totalsalary As Long, myrng As Range

Set myrng = rng

salary = CLng(myrng.Value)

Select Case (salary <= 900)
Case True

    totalsalary = salary + salary * ((commission.grade1) / 1000)
 
Case Else
    Select Case (900 < salary <= 1000)
    Case True
    totalsalary = salary + salary * ((commission.grade2) / 1000)
    Case Else
        Select Case (1000 < salary)
        Case True
            totalsalary = salary + salary * ((commission.grade3) / 1000)
        End Select
    End Select

End Select

Calculatesalary = totalsalary


totalsalary = 0
End Function

For details read

http://www.cpearson.com/excel/Enums.aspx

Count of Vowels In A String USING VBA

Option Explicit
Dim i As Integer, j As Integer
Dim myval As String
Sub countofVowels()
myval = Application.InputBox("Enter a word", "Word", Type:=2)

For i = 1 To Len(myval)
If LCase(Mid(myval, i, 1)) Like "[a,e,i,o,u]" Then
j = j + 1
End If


Next
MsgBox "Total count of Vowels" & j
i = 0
j = 0
End Sub

Insert Multiple Row before Unique Value through VBA

Region	Product	Grand_Total
ANZ	Tech	159
ANZ	OFM	70
ANZ	OFM	70
TC	HCIL	41
TC	HCIL	297
ASEAN	Apps	80
ASEAN	Apps	587
ASEAN	Systems	350
ASEAN	Apps	34
MGI	ORC	600
MGI	ORC	658
MGI	ORC	750
DL	ORG	340
DL	ORG	123
DL	ORG	107
GC	Systems	161
GC	Apps	83
GC	Apps	83
HR	CI	611
HR	CI	113
HR	CI	596
IN	Tech	551
IN	Tech	832
IN	Tech	66
KR	Tech	275
KR	OFM	87
KR	OFM	81
MP	HCL	665
MP	HCL	579
HP	MPGC	662
HP	MPGC	672
HP	MPGC	319
HP	MPGC	772
HP	MPGC	129

For example  if you want to insert a row after every unique region here is code

Option Explicit
Dim mycoll As Collection, strrow As String, finalstrrow As String
Dim myrng As Range, rowcount As Long, cell, i As Integer
Sub insertRowafterUnique()
rowcount = ThisWorkbook.Sheets(1).Range("A1").End(xlDown).Row
Set mycoll = New Collection
Set myrng = ThisWorkbook.Sheets(1).Range("A2:A" & rowcount)
strrow = vbNullString
On Error Resume Next
    For Each cell In myrng
        mycoll.Add cell, CStr(cell)

    Next
 
    For i = 2 To rowcount
            If ThisWorkbook.Sheets(1).Range("A" & i) <> ThisWorkbook.Sheets(1).Range("A" & (i + 1)) Then
                strrow = strrow & (i + 1) & ":" & (i + 1) & ","
             
 
 
            End If
    Next
    finalstrrow = Left(strrow, Len(strrow) - 1)
    ThisWorkbook.Sheets(1).Range(finalstrrow).EntireRow.Insert
End Sub

Find vs Search

Find
- Case Sensitive
- Can't using Wildcard

Seach
- Not Case Sensitive
- Can Using Wildcard

Create Validation by Removing Duplicates

A

B

C

D

B

C

A

F

G

D

A

Option Explicit
Dim rowcount As Long
Dim myarray As New Collection, tempval As String, finaltempval As String

Sub addValidation()
On Error Resume Next
rowcount = Sheets(2).Range("a3").End(xlDown).Row
For i = 3 To rowcount
tempval = vbNullString
myarray.Add Range("A" & i), Range("A" & i)

Next i
For j = 1 To myarray.Count
    tempval = tempval & myarray(j) & ","

Next j

finaltempval = Mid(tempval, 1, Len(tempval) - 1)

With Range("B1").Validation

    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=finaltempval

End With
finaltempval = vbNullString
End Sub

Hide Formula in Workbook

Goto format of cell - protection- check Hidden - OK....after this protect your sheet...

Setting Up Expiry Date for Workbook

Private Sub Workbook_Open()
    Dim ExpDate As Date
    ExpDate = #8/17/2013 10:00:00 AM#
    
    If Now > ExpDate Then ThisWorkbook.Close
    MsgBox "This workbook will expired at " & Format(ExpDate, "dd mmmm yyyy hh:mm:ss AM/PM")
End Sub

VBA Automation for MS Excel File

In Master Sheet there are three cells in attached sheet G1,G2 & J2.  When I will run macro it should check that whether values are entered in these cells.  If any one of cells are blank, cell should be RED and give message that values are not entered. and then it should ask Do you want to enter data now, if yes input box for entering value.


Option Explicit
Dim birth As Range, PANNo As Range, empName As Range, userInput



Sub validateData()
Application.ScreenUpdating = False
Set birth = [G2]
Set PANNo = [J2]
Set empName = [G1]
If IsEmpty(empName) Then
    [empName].Interior.ColorIndex = 3
    [empName].Interior.Pattern = xlSolid
    If MsgBox("Employee Name is empty;Please enter now", vbYesNo) = vbYes Then
        userInput = Application.InputBox("Please Enter Employee name", Type:=2)
        If Len(userInput) > 0 Then
            [empName].Value = userInput
            [empName].Interior.ColorIndex = 2
        End If
    End If
End If
If IsEmpty(birth) Then
    [birth].Interior.ColorIndex = 3
    [birth].Interior.Pattern = xlSolid
    If MsgBox("Date of Birth is empty; Please enter now", vbYesNo) = vbYes Then
    userInput = vbNullString
        userInput = Application.InputBox("Enter DOB", "DOB in mm/dd/yyyy format", Default:=Format(Date, "mm/dd/yyyy"), Type:=2)
        If IsDate(userInput) Then
            [birth].Value = userInput
            [birth].Interior.ColorIndex = 2
        End If
    End If

 
End If
If IsEmpty(PANNo) Then

    [PANNo].Interior.ColorIndex = 3
    [PANNo].Interior.Pattern = xlSolid
    If MsgBox("PAN No. is empty;Please enter now", vbYesNo) = vbYes Then
        userInput = vbNullString
        userInput = Application.InputBox("Enter PAN No.", "PAN No.", Type:=2)
        If Len(userInput) = 10 Then
            [PANNo].Value = userInput
            [PANNo].Interior.ColorIndex = 2
        End If
    End If
End If
End Sub

https://docs.google.com/file/d/0B23eJ2xd9ODybDdROVo4dUxLVjA/edit?usp=sharing

Use Split in VBA

Sub useSplitinVBA()
Dim myarry1 As Variant
Dim i As Integer
On Error Resume Next
myarry1 = Split(Sheet1.Cells(1, 1).Value, "\")
    For i = LBound(myarry1) To UBound(myarry1)
 
        If WorksheetFunction.Find(",", myarry1(i)) > 0 Then
        myarry2 = Split(myarry1(i), ",")
            For k = LBound(myarry2) To UBound(myarry2)
            MsgBox myarry2(k)
            Next
        End If
 
    Next
End Sub

Using Resize Property to Change the size of a range

The Resize property enables you to change the size of a range based on the location of the active cell.
You can create a new range as you need it.

For Example

Sub rngresize()

    Set Rng = Range("B1:B16").Find(What:="0", LookAt:=xlWhole, LookIn:=xlValues)
 
    Rng.Offset(, -1).Resize(, 2).Interior.ColorIndex = 15


End Sub


https://docs.google.com/file/d/0B23eJ2xd9ODySGNBdEhITWNKeHc/edit?usp=sharing

Print Userform in Landscape Format

Private Declare Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long)

'dwFlags parameter of keybd_event controls various aspects of function operation. _

'This parameter can be one or more of the following values.

'KEYEVENTF_KEYUP
'if specified, the key is being released.If not specified, the key is being depressed.

'KEYEVENTF_EXTENDEDKEY
'If specified, the scan code was preceded by a prefix _
'byte having the value 0xE0 (224).

Private Const KEYEVENTF_KEYUP = &H2
Private Const KEYEVENTF_EXTENDEDKEY = &H1
'Print Screen key
Private Const VK_SNAPSHOT = &H2C
'Alt Key
Private Const VK_MENU = &H12
'Left Alt Key
Private Const VK_LMENU = &HA4

Private Sub CommandButton1_Click()
    Dim wshTemp As Worksheet
    DoEvents

    ' Simulate pressing ALT+Printscreen to copy the form window (=picture) to
    ' the clipboard
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
    DoEvents

    ' Add a worksheet named Temp
    ThisWorkbook.Worksheets.Add
    ActiveSheet.Name = "Temp"
    Set wshTemp = ThisWorkbook.Worksheets("Temp")

    ' Paste the picture, set print orientation to landscape en print it
    With wshTemp
     .Paste
     .PageSetup.Orientation = xlLandscape
     .PrintOut
    End With

    ' Delete the worksheet Temp and suppress the not-saved Warning.
    Application.DisplayAlerts = False
    ThisWorkbook.Worksheets("Temp").Delete
    Application.DisplayAlerts = True
End Sub

For reference:

http://msdn.microsoft.com/en-us/library/windows/desktop/ms646267.aspx

Searching Files of All Format in a Folder

Option Explicit
Dim pathname As String
Dim i As Integer
Dim fso As Object
Dim folder1 As Object
Dim file1 As Object
Sub getFileDetailsunderSpecifiedFolder()
pathname = Application.InputBox("Provide path of specified Folder", "Pathname", Type:=2)
i = 2
Set fso = New Scripting.FileSystemObject
Set folder1 = fso.GetFolder(pathname)
    For Each file1 In folder1.Files
        Cells(i, 1) = file1.Name
        Cells(i, 2) = Environ("Username")
        Cells(i, 3) = file1.DateLastAccessed
        Cells(i, 4) = file1.DateLastModified
   
        i = i + 1
   
    Next
End Sub


https://docs.google.com/file/d/0B23eJ2xd9ODyampNbDRmOEd3R3c/edit?usp=sharing

Compare Strings in Cases Insensitive Cases

When you compare 2 Strings for Case insensitive cases use
Option Compare Text at the top of the sub procedure.

One small example

Option Compare Text

Sub check()
If ("A" = "a") Then

MsgBox "Case insensitive"
End If
End Sub

Listing of File Names with Different Folders

Public pathname As String
Public fileformat As String
Dim strfile As String
Dim rowcount As Long
'Parameters are passed from Forms
Sub ListFiles()

rowcount = 2
strfile = Dir(pathname & "\" & fileformat, vbNormal)
    If Len(strfile) = 0 Then
            MsgBox "No file Exists", vbOKOnly

    End If
    Application.ScreenUpdating = False
    Do While Len(strfile) > 0
 
        Cells(rowcount, 3) = strfile
        Cells(rowcount, 4) = FileDateTime(pathname & "\" & strfile)
        rowcount = rowcount + 1
        'get nextfile from Folder
        strfile = Dir
    Loop
    Columns.AutoFit
End Sub

Convert Excel File To PDF

Sub Excel2PDFConverter()
With Application.FileDialog(msoFileDialogFolderPicker)
              .Show
              Path = .SelectedItems(1)
End With
              ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & "\" & "exceltopdf"
End Sub

Creating a Folder Inside SubFolder

'take reference of Microsoft Scripting Runtime
Sub createFolderinsideSubFolder()
Dim fso As Scripting.FileSystemObject
Dim parentfolder As Object
Dim subfolder As Object
Dim myfolder As String

Set fso = CreateObject("Scripting.FileSystemObject")
myfolder = "D:\Somu\"
Set parentfolder = fso.GetFolder(myfolder)
For Each subfolder In parentfolder.SubFolders
'searching all SubFolders inside D:\Somu\
myfolder = subfolder.Path & "\2013"
    If Not fso.FolderExists(myfolder) Then
        MkDir (myfolder)
    End If
Next

End Sub

ConnectionString Briefing(Used in SQL Server connectivity)

In computing, a Connectionstring is a string that specifies information about a data source and the means of connecting to it. It is passed in code to an underlying driver or provider in order to initiate the connection. Whilst commonly used for a database connection, the data source could also be a spreadsheetor text file.  ConnectionString property can be set only when the connection is closed. The connection string is parsed immediately after being set. If errors in syntax are found when parsing, a runtime exception, such asArgumentException, is generated. Other errors can be found only when an attempt is made to open the connection.
The connection string may include attributes such as the name of the driver, server and database, as well as security information such as user name and password.
For Reference:
www.connectionstrings.com

For example:
 con_string = "DRIVER={MySQL ODBC 3.51 Driver};user=internalros;password=internalros;database=TBS; server=206.71.169.000;option=18475"
ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Data Source=NEW\SQLEXPRESS;"

ODBC-it is designed for connecting to relational databases.
However, OLE DB can access relational databases as well as nonrelational databases.
List of Parameters for Microsoft OLE-DB Provider:

https://docs.google.com/file/d/0B23eJ2xd9ODyZDg2ZFdCZUM1MWM/edit?usp=sharing

Suffixes after variable name in VBA

Dim A!, B@, C#, D$, E%, F&

Debug.Print "A! - " & TypeName(A)
Debug.Print "B@ - " & TypeName(B)
Debug.Print "C# - " & TypeName(C)
Debug.Print "D$ - " & TypeName(D)
Debug.Print "E% - " & TypeName(E)
Debug.Print "F& - " & TypeName(F)

A! - Single
B@ - Currency
C# - Double
D$ - String
E% - Integer
F& - Long

For Reference:

http://support.microsoft.com/kb/110264

Export Userform to Another Workbook

Dim vbcomponent As Variant
Sub exportForm()
On Error Resume Next
Dim wbSource As Workbook, wbDestination As Workbook
Set wbSource = Workbooks.Open("C:\abc\DIR\Desktop\Book1")
Set wbDestination = ThisWorkbook
For Each vbcomponent In wbSource.VBProject.VBComponents
        If (vbcomponent.Name = "displayForm") Then
     
                wbSource.VBProject.VBComponents(vbcomponent.Name).Export "C:\temp\displayForm.frm"
                wbDestination.VBProject.VBComponents.Import "C:\temp\displayForm.frm"
        End If
     
     
Next
        Kill "C:\temp\displayForm.frm"
        Kill "C:\temp\displayForm.frx"
     
wbSource.Close
End Sub

Sending mails without taking Outlook Reference

If your mailId is configured to Outlook Express; following code will send mails of each excel sheet

Sub Mail_every_Worksheet()

    Dim strDate As String
    Dim sh As Worksheet
    Application.ScreenUpdating = False
    For Each sh In ThisWorkbook.Worksheets
        If sh.Range("a1").Value Like "*@*" Then
            sh.Copy
            strDate = Format(Date, "dd-mm-yy") & " " & Format(Time, "h-mm-ss")
            ActiveWorkbook.SaveAs "Part of " & ThisWorkbook.Name _
                                & " " & strDate & ".xls"
            ActiveWorkbook.SendMail ActiveSheet.Range("a1").Value, _
                                    ActiveSheet.Range("b1").Value
            ActiveWorkbook.ChangeFileAccess xlReadOnly
         
            ActiveWorkbook.Close False
        End If
    Next sh
    Application.ScreenUpdating = True

End Sub

Calculate Age Using Nested Select Case

Sub calculateAge()
Dim tempdate As Date, sysdate As Date, mydob As Date
Dim y As Integer, m As Integer, d As Integer
mydob = CDate(Application.InputBox("Select your DoB", "DoB", Default:=Format(Date, "mm/dd/yyyy"), Type:=2))
sysdate = Format(Date, "mm/dd/yyyy")
tempdate = DateSerial(Year(Date), Month(mydob), Day(mydob))

Select Case (tempdate > sysdate)

    Case True
                y = Year(sysdate) - Year(mydob) - 1
             
                Select Case Day(mydob) > Day(Date)
                    Case True
                           
                        m = -Month(mydob) - 12 * (tempdate > sysdate) + Month(Date) - 1
                        d = Day(DateSerial(Year(Date), Month(Date), 0)) - Day(mydob) + Day(Date)
                    Case False
                        m = -Month(mydob) - 12 * (tempdate > sysdate) + Month(Date)
                        d = Day(Date) - Day(mydob)
                End Select
    Case Else
                y = Year(sysdate) - Year(mydob)
                Select Case Day(mydob) > Day(Date)
                    Case True
                           
                        m = Month(Date) - Month(mydob) - 1
                        d = Day(DateSerial(Year(Date), Month(Date), 0)) - Day(mydob) + Day(Date)
                    Case False
                        m = Month(Date) - Month(mydob)
                        d = Day(Date) - Day(mydob)
                End Select
       
End Select
MsgBox "Your Age is" & y & " years " & m & "months" & d & "days"
End Sub

Remote Connection for SQL Server

Dim rec As New ADODB.Recordset
Dim con As New ADODB.Connection
Dim col As Long, row As Long

con_string = "DRIVER={MySQL ODBC 3.51 Driver};user=internalros;password=internalros;database=TBS;server=206.71.169.000;option=18475"
con.ConnectionString = con_string
con.Open

Brief Introduction to Sensitivity Analysis

A technique used to determine how different values of an independent variable will impact a particular dependent variable under a given set of assumptions. This technique is used within specific boundaries that will depend on one or more input variables, such as the effect that changes in interest rates will have on a bond's price.

One of the finest features in Microsoft Excel is sensitivity analysis using either a table (Excel 2003) or 'What-if' in Excel 2007. Suppose you want to start a cybercafe or a restaurant in a new mall. You have done a study on the footfall and the kind of people who visit the mall. You have also found out about the business atmosphere, security and rent or the outright purchase price. You also know the rates in the market that other businesses are charging, let's say, for surfing the net per hour. You then estimate your capital costs like doing up the cybercafe and the price of the computers. You also use the Excel spreadsheet to estimate and calculate the number of people you'll need to run the show and the amount of salaries you'll have to pay. You have also estimated other variable costs like electricity and phone.

From the above data in the Excel worksheet you can calculate your total monthly or yearly costs. Now based on a certain price that you will charge the customers, number of computers and working hours you can calculate your revenue per month or per year. From the data of revenue and income you can easily calculate the profit. Till now everything was easy to implement in Excel.

Now you decide to find out how your profit can vary if you vary the charge per hour or the number of people who will visit your cybercafe or establishment. Of course, you cannot charge what you want but you can get a good estimate by observing what others are charging and what quality of service and environment they are providing.

Arranging all your data properly, click on 'Data' in the ribbon in Microsoft Office 2007 or 'Data' in the menu bar in Excel 2003. In Excel 2007 select 'What-if' analysis and finally 'Data Table...'. In the popup window in the 'Row input cell' type the data that you have input horizontally next to the profit and in the 'column input cell' write down the price and vary it it by 1% 0r 2% so that that Excel can perform an analysis for, say., $0.5 per hour charge for a cybercafe to $1.5 per hour. The horizontal values can be the number of people per hour or month or year that will visit the shop and keep on varying the values by a certain estimated percentage. Click 'OK' and you can see how your profit varies with the number of customers and the price you charge. This is also known as a two variable table because you calculated the changes in your profit based on two parameters - price and number of customers.

Contribution by Dr. Dinesh K Takyar



<!--[if !supportLineBreakNewLine]-->
<!--[endif]-->

VBA Code for Calendar(without ActiveX control)

Dim selecteddate As Date
Dim cbtarget As msforms.ComboBox, cbtarget1 As msforms.ComboBox
Dim myrng As Range

Private Sub ComboBox1_Change()
Dim dayscount
Dim tempvar
Dim dayName
Dim currentdate
Dim i As Integer, j As Integer
Dim cmdbutton1 As msforms.CommandButton
dayName = Format(DateSerial(year(Date), ComboBox1.ListIndex + 1, 1), "ddd")
Dim counter As Integer, daycounter As Integer
Dim cmdbutton() As Variant
dayscount = Day(DateSerial(year(Date), ComboBox1.ListIndex + 2, 0))
cmdbutton = Array("CommandButton1", "CommandButton2", "CommandButton3", "CommandButton4", "CommandButton5", "CommandButton6", "CommandButton7", "CommandButton8", "CommandButton9", "CommandButton10", "CommandButton11", "CommandButton12", "CommandButton13", "CommandButton14", "CommandButton15", "CommandButton16", "CommandButton17", "CommandButton18", "CommandButton19", "CommandButton20", "CommandButton21", "CommandButton22", "CommandButton23", "CommandButton24", "CommandButton25", "CommandButton26", "CommandButton27", "CommandButton28", "CommandButton29", "CommandButton30", "CommandButton31", "CommandButton32", "CommandButton33", "CommandButton34", "CommandButton35", "CommandButton36", "CommandButton37", "CommandButton38")
currentdate = Format(Date, "dd")
If ComboBox1.Value <> vbNullString Then
    If dayName = "Sun" Then
        counter = 0
        daycounter = 1
    ElseIf dayName = "Mon" Then
        Calendar.Controls(cmdbutton(0)).Visible = False
        counter = 1
        daycounter = 1
    ElseIf dayName = "Tue" Then
        Calendar.Controls(cmdbutton(0)).Visible = False
        Calendar.Controls(cmdbutton(1)).Visible = False
        counter = 2
        daycounter = 1
    ElseIf dayName = "Wed" Then
        Calendar.Controls(cmdbutton(0)).Visible = False
        Calendar.Controls(cmdbutton(1)).Visible = False
        Calendar.Controls(cmdbutton(2)).Visible = False
        counter = 3
        daycounter = 1
    ElseIf dayName = "Thu" Then
        Calendar.Controls(cmdbutton(0)).Visible = False
        Calendar.Controls(cmdbutton(1)).Visible = False
        Calendar.Controls(cmdbutton(2)).Visible = False
        Calendar.Controls(cmdbutton(3)).Visible = False
        counter = 4
        daycounter = 1
    ElseIf dayName = "Fri" Then
        Calendar.Controls(cmdbutton(0)).Visible = False
        Calendar.Controls(cmdbutton(1)).Visible = False
        Calendar.Controls(cmdbutton(2)).Visible = False
        Calendar.Controls(cmdbutton(3)).Visible = False
        Calendar.Controls(cmdbutton(4)).Visible = False
        counter = 5
        daycounter = 1
    ElseIf dayName = "Sat" Then
        Calendar.Controls(cmdbutton(0)).Visible = False
        Calendar.Controls(cmdbutton(1)).Visible = False
        Calendar.Controls(cmdbutton(2)).Visible = False
        Calendar.Controls(cmdbutton(3)).Visible = False
        Calendar.Controls(cmdbutton(4)).Visible = False
        Calendar.Controls(cmdbutton(5)).Visible = False
        counter = 6
        daycounter = 1
       
    End If
    For i = counter To (counter + dayscount) - 1
       
        Calendar.Controls(cmdbutton(i)).Visible = True
        Calendar.Controls(cmdbutton(i)).BackColor = RGB(135, 206, 250)
        Calendar.Controls(cmdbutton(i)).ForeColor = RGB(102, 0, 51)
        Calendar.Controls(cmdbutton(i)).FontBold = True
        Calendar.Controls(cmdbutton(i)).Caption = daycounter
        If (daycounter = currentdate) And ((ComboBox1.ListIndex + 1) = Month(Date)) Then
           
            Calendar.Controls(cmdbutton(i)).BackColor = RGB(255, 255, 204)
           
        End If
        daycounter = daycounter + 1
    Next i
    For j = (counter + dayscount) To 37
        Calendar.Controls(cmdbutton(j)).Visible = False
    Next j
End If

End Sub
Private Sub CommandButton1_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton1.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton2_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton2.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton3_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton3.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton4_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton4.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton5_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton5.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton6_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton6.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton7_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton7.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton8_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton8.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton9_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton9.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton10_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton10.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton11_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton11.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton12_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton12.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton13_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton13.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton14_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton14.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton15_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton15.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton16_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton16.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton17_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton17.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton18_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton18.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton19_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton19.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton20_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton20.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton21_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton21.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton22_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton22.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton23_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton23.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton24_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton24.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton25_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton25.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton26_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton26.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton27_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton27.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton28_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton28.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton29_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton29.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton30_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton30.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton31_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton31.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton32_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton32.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton33_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton33.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton34_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton34.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton35_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton35.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton36_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton36.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton37_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton377.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub
Private Sub CommandButton38_Click()
Set cbtarget1 = Calendar.ComboBox2
Set cbtarget = Calendar.ComboBox1
selecteddate = DateSerial(cbtarget1.Value, cbtarget.ListIndex + 1, CommandButton38.Caption)
PlayerMaster.TextBox6 = Format(selecteddate, "dd-mmm-yyyy")
Unload Calendar
End Sub

Private Sub Label3_Click()
End Sub
Private Sub UserForm_Initialize()
Set myrng = ThisWorkbook.Sheets(1).Range("L1:L12")
Set cbtarget = Me.ComboBox1
Set cbtarget1 = Me.ComboBox2
cbtarget.List = myrng.Cells.Value
cbtarget1.Value = year(Date)
cbtarget.Value = Format(Date, "mmm")

Label3.ForeColor = 255
End Sub

Generate Next Id For AphaNumericValue

Excel formula     ="P"&TEXT(MAX(--SUBSTITUTE(A2:A33,"P","")+1),"00000") Press Control+Shift+Enter Data

P00001

P00003

P00004

P00005

P00006

P00007

P00008

P00010

P00011

P00013

P00014

P00015

P00016

P00018

P00019

P00020

P00021

P00022

P00023

P00024

P00034

P00036

P00037

P00039

P00040

P00041

P00042

P00043

P00044

P00047

P00048

P00049