Announcement

Collapse
No announcement yet.

Small Excel Application for You all to analyse

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Small Excel Application for You all to analyse



    Hello,

    Recently, saw a lot of post on how to handle, transfer and copy data from one sheet to another.
    Also... I had promised Dave in one of my early posts, that I will contribute a small but smart application in Excel, and I am trying to live up to it. Don't know how much successful I am.

    Here is a small Application in Excel which includes:

    1. Showing Form-like structure without using form
    2. Hiding all traces of Excel when the application is activated
    3. Enabling menus and commandbars when the file is closed or deactivated
    4. A complete Data Entry and Data Retrival system for a table with 6 fields
    5. A complete and Full-proof Navigation system through the data, alongwith display of record position
    6. Add, Edit, Delete Records with proper enable / disable / hide / unhide of buttons and the entry fields
    7. Different colour scheme for entry and view mode.


    The code, though huge is pasted below, hope this will be useful to those interested. Also attached the application for your use.

    Please be kind enough to send your suggestions / comments through U2U or mail.

    Hope i can correct my code in the process and get some more ideas

    ============================================================

    Sub Workbook_Activate()

    Run Sheets("Form").wbk_activate()
    End Sub
    Private Sub Workbook_Deactivate()

    Application.CommandBars.ActiveMenuBar.Enabled = True

    With ActiveWindow
    .DisplayHeadings = True
    .DisplayHorizontalScrollBar = True
    .DisplayVerticalScrollBar = True
    .DisplayWorkbookTabs = True
    End With

    With Application
    .DisplayFormulaBar = True
    .DisplayFullScreen = False
    .DisplayFormulaBar = True
    End With


    End Sub

    Private Sub Workbook_Open()
    Sheets("Form").Select
    Range("Sr").Select
    Range("Sr").Value = 1
    ActiveSheet.unprotect
    ActiveSheet.EnableSelection = xlUnlockedCells
    Run Sheets("Form").populate()
    Run Sheets("Form").protect_rng()
    ActiveSheet.protect
    Worksheets("Form").ScrollArea = "B3:H50"
    Range("Name").Select

    End Sub


    Sub protect_rng()

    Dim data_disp(6) As String

    data_disp(0) = "Name"
    data_disp(1) = "Ext."
    data_disp(2) = "Mail_UID"
    data_disp(3) = "Machine"
    data_disp(4) = "AIM_id"
    data_disp(5) = "Resp"

    ActiveSheet.unprotect

    For x = 0 To 5
    With Range(data_disp(x))
    .Locked = True
    .Interior.ColorIndex = 20
    End With
    Next

    ActiveSheet.protect

    End Sub
    Sub unprotect_rng()
    Dim data_disp(6) As String

    data_disp(0) = "Name"
    data_disp(1) = "Ext."
    data_disp(2) = "Mail_UID"
    data_disp(3) = "Machine"
    data_disp(4) = "AIM_id"
    data_disp(5) = "Resp"

    ActiveSheet.unprotect

    For x = 0 To 5
    With Range(data_disp(x))
    .Locked = False
    .Interior.ColorIndex = 19
    End With
    Next
    'Run Sheets("From").disable_navig()
    ActiveSheet.protect

    End Sub
    Sub clear()

    Dim data_disp(6) As String

    data_disp(0) = "Name"
    data_disp(1) = "Ext."
    data_disp(2) = "Mail_UID"
    data_disp(3) = "Machine"
    data_disp(4) = "AIM_id"
    data_disp(5) = "Resp"

    ActiveSheet.unprotect

    For x = 0 To 5
    Range(data_disp(x)).Value = ""
    Range(data_disp(x)).Locked = True
    Next

    Range("Name").Select

    ActiveSheet.protect
    End Sub
    Public Sub populate()

    Dim pos As Long
    Dim data_disp(6) As String
    ActiveSheet.unprotect
    pos = Range("Sr").Value

    data_disp(0) = "Name"
    data_disp(1) = "Ext."
    data_disp(2) = "Mail_UID"
    data_disp(3) = "Machine"
    data_disp(4) = "AIM_id"
    data_disp(5) = "Resp"

    For x = 0 To 5
    Range(data_disp(x)).Locked = False
    Range(data_disp(x)).Value = Sheets("Data").Range("A1").Offset(pos, x + 1).Value
    Range(data_disp(x)).Locked = True
    Next

    'Sheets("Form").Select
    'Range("Name").Select
    ActiveSheet.protect
    End Sub

    Private Sub Cmd_Cancel_Click()

    Dim res As VbMsgBoxResult
    res = MsgBox("Do you want to descard the changes you have made?", vbYesNo, "Cancel Changes")
    If res = vbYes Then

    Sheets("Form").Range("Sr").Value = Sheets("Form").Range("On_Cancel").Value
    Sheets("Form").Range("On_Cancel").Value = ""
    Run Sheets("Form").populate()
    Run Sheets("Form").protect_rng()
    Cmd_Cancel.Enabled = False
    Cmd_Cancel.Visible = False
    Cmd_Edit.Enabled = True
    Cmd_Add.Enabled = True
    Cmd_Del.Enabled = True
    Cmd_Save.Enabled = False
    Run Sheets("Form").validate_navig()
    End If

    End Sub

    Private Sub Cmd_Close_Click()
    Dim res As VbMsgBoxResult


    res = MsgBox("Do you want to Exit the Application?", vbYesNo, "Exit Decision")

    If res = vbYes Then
    Run Sheets("Form").wbk_deactivate()
    ActiveWorkbook.Close (Savechanges = True)
    End If

    End Sub

    Sub Cmd_Edit_Click()
    Sheets("Form").Range("On_Cancel").Value = Sheets("Form").Range("Sr").Value
    Run Sheets("Form").unprotect_rng()
    Cmd_Edit.Enabled = False
    Cmd_Add.Enabled = False
    Cmd_Del.Enabled = False
    Cmd_Cancel.Enabled = True
    Cmd_Cancel.Visible = True
    Cmd_Save.Enabled = True
    Run Sheets("Form").disable_navig()
    Range("Name").Select


    End Sub

    Sub Cmd_Del_Click()
    Dim res As VbMsgBoxResult
    Dim pos As Long
    pos = Range("Sr").Value
    res = MsgBox("Do you want to delete record for " & Range("Name").Value, vbYesNo, "Record Deletion")

    If res = vbYes Then
    Sheets("Data").Range("A1").Offset(pos, 0).EntireRow.Delete
    Run Sheets("Form").cmd_Prv_Click()
    End If

    End Sub

    Sub Cmd_Add_Click()
    Sheets("Form").Range("On_Cancel").Value = Sheets("Form").Range("Sr").Value
    Run Sheets("Form").clear()
    Run Sheets("Form").unprotect_rng()
    Range("Sr").Value = Sheets("Form").Range("cur_max").Value + 1
    ActiveWorkbook.Save
    Cmd_Edit.Enabled = False
    Cmd_Add.Enabled = False
    Cmd_Del.Enabled = False
    Cmd_Cancel.Enabled = True
    Cmd_Cancel.Visible = True
    Cmd_Save.Enabled = True
    Run Sheets("Form").disable_navig()
    Range("Name").Select

    End Sub


    Sub Cmd_Save_Click()

    Dim pos As Long
    Dim data_disp(6) As String

    If Trim(Range("Name").Value) = "" Then MsgBox "Please enter Name": Exit Sub

    pos = Range("Sr").Value

    data_disp(0) = "Name"
    data_disp(1) = "Ext."
    data_disp(2) = "Mail_UID"
    data_disp(3) = "Machine"
    data_disp(4) = "AIM_id"
    data_disp(5) = "Resp"
    Sheets("Data").Range("A1").Offset(pos, 0).Formula = "=row()-1"
    For x = 0 To 5
    Sheets("Data").Range("A1").Offset(pos, x + 1).Value = Range(data_disp(x)).Value
    Next

    Run Sheets("Form").protect_rng()
    'Sheets("Form").Select
    'Range("Name").Select

    Sheets("Form").Range("On_Cancel").Value = ""
    ActiveWorkbook.Save
    Cmd_Cancel.Visible = False
    Cmd_Cancel.Enabled = False
    Cmd_Save.Enabled = False
    Cmd_Edit.Enabled = True
    Cmd_Add.Enabled = True
    Cmd_Del.Enabled = True
    Run Sheets("Form").validate_navig()
    End Sub

    Sub Cmd_First_Click()

    Range("Sr").Value = 1

    Calculate
    Run Sheets("Form").populate()

    Run Sheets("Form").validate_navig()

    End Sub

    Sub cmd_Last_Click()

    Range("Sr").Value = Sheets("Data").Range("Data_Sr").Count - 1

    Calculate
    Run Sheets("Form").populate()

    Run Sheets("Form").validate_navig()
    End Sub

    Sub cmd_Next_Click()
    If Range("Sr").Value < Sheets("Data").Range("Data_Sr").Count - 1 Then
    Range("Sr").Value = Range("Sr").Value + 1
    End If
    Calculate
    Run Sheets("Form").populate()

    Run Sheets("Form").validate_navig()
    End Sub

    Sub cmd_Prv_Click()

    If Range("Sr").Value &gt; 1 Then
    Range("Sr").Value = Range("Sr").Value - 1

    End If

    Calculate
    Run Sheets("Form").populate()

    Run Sheets("Form").validate_navig()
    End Sub


    Sub disable_navig()
    Cmd_First.Enabled = False
    cmd_Last.Enabled = False
    cmd_Next.Enabled = False
    cmd_Prv.Enabled = False
    End Sub

    Sub validate_navig()
    cmd_Next.Enabled = True
    cmd_Last.Enabled = True
    Cmd_First.Enabled = True
    cmd_Prv.Enabled = True

    If Range("Sr").Value >= Sheets("Data").Range("data_Sr").Count - 1 Then
    cmd_Next.Enabled = False
    cmd_Last.Enabled = False
    Cmd_First.Enabled = True
    cmd_Prv.Enabled = True
    End If

    If Range("Sr").Value <= 1 Then
    Cmd_First.Enabled = False
    cmd_Prv.Enabled = False
    cmd_Next.Enabled = True
    cmd_Last.Enabled = True
    End If

    End Sub

    Sub wbk_activate()


    Application.ScreenUpdating = False

    Application.CommandBars.ActiveMenuBar.Enabled = False

    With ActiveWindow
    .DisplayHeadings = False
    .DisplayHorizontalScrollBar = False
    .DisplayVerticalScrollBar = False
    .DisplayWorkbookTabs = False
    End With

    With Application
    .DisplayFormulaBar = False
    .DisplayFullScreen = True
    .DisplayFormulaBar = False
    .ScreenUpdating = True
    End With

    End Sub

    Sub wbk_deactivate()

    Application.CommandBars.ActiveMenuBar.Enabled = True

    With ActiveWindow
    .DisplayHeadings = True
    .DisplayHorizontalScrollBar = True
    .DisplayVerticalScrollBar = True
    .DisplayWorkbookTabs = True
    End With

    With Application
    .DisplayFormulaBar = True
    .DisplayFullScreen = False
    .DisplayFormulaBar = True
    End With

    End Sub
    Thanks: ~Yogendra
Working...
X