Solved

How to Auto-fill data in Database

Posted on 2016-11-19
2
30 Views
Last Modified: 2016-11-20
In my Database I only want the user to be allowed to input data (from a custom Userform) in columns D & E. Column A updates OK with the Next No. but I need Columns B & C to auto fill and update with consecutive Day/Date, and auto update column F is a calculation from D & E. Auto update for column G Rate (is derived from a look up Table), and then column H Penalty (also a calculation from other data in the Workbook.

Option Explicit
Dim ws As Worksheet
Dim rData As Range
Dim CurrentRow As Long
Dim lcol As Long
Dim r As Long
Dim j As Integer


'
'Private Sub setinitialrange()
'
'    Set rData = Range("A4").CurrentRegion
'    currentrow = rData.Cells(rData.Rows.Count).End(xlUp).Row
'End Sub

Private Sub cmbAddRecord_Click()
    EditAdd
End Sub

Sub EditAdd()
    Dim emptyrow As Long, flag As Boolean, txtConDay As Long
    Dim lr As Long

    Set ws = Sheets("Sheet1")
    lr = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
    If WorksheetFunction.CountIf(ws.Columns(1), Me.txtConDay) > 0 And txtConDay <> "" Then
        MsgBox "The record for this Contract Day already exists in the database." & vbNewLine & _
               "Please try again.....", vbCritical, "Contract Day Already Exists!"
        txtConDay = ""
        txtDay = ""
        txtDate = ""
        txtStd = ""
        txtAtd = ""
        txtPerf = ""
        txtRate = ""
        txtPenalty = ""

        Exit Sub
    End If

    ''///new record, if txtConDay has a value then a record exists and will be amended
    If Me.txtConDay.Value = "" Then
        Me.txtConDay.Value = Application.Max(rData.Columns(1)) + 1
        CurrentRow = rData.Rows.Count + 1
    End If
    txtConDay = Application.Max(ws.Columns(1)) + 1
    With Me
        Cells(lr, 1).Value = txtConDay.Value
        Cells(lr, 2).Value = txtDay.Value
        Cells(lr, 3).Value = txtDate.Value
        Cells(lr, 4).Value = txtStd.Value
        Cells(lr, 5).Value = txtAtd.Value
        Cells(lr, 6).Value = txtPerf.Value
        Cells(lr, 7).Value = txtRate.Value
        Cells(lr, 8).Value = txtPenalty.Value

    End With
    ClearForm

End Sub

Private Sub cmdbNextRecord_Click()
    If CurrentRow = rData.Rows.Count Then
        MsgBox "You have selected the last record", vbCritical, "Cancel"
        Exit Sub
    Else: CurrentRow = CurrentRow + 1

    End If
End Sub

Private Sub cmdbPreviousRecord_Click()
    If CurrentRow = 2 Then
        MsgBox "You have selected the first record", vbCritical, "Cancel"
        Exit Sub
    Else
        CurrentRow = CurrentRow - 1

    End If
End Sub

Sub cmdClear_Click()
    ClearForm
End Sub

Sub ClearForm()
'/// if you use a With Statement then the control needs prefixing with .
    With Me
        .txtConDay.Value = ""
        .txtDay.Value = ""
        .txtDate.Value = ""
        .txtStd.Value = ""
        .txtAtd.Value = ""
        .txtPerf.Value = ""
        .txtRate.Value = ""
        .txtPenalty.Value = ""

    End With
End Sub

Private Sub cmdFirstRecord_Click()
''///jumps to next empty row
    CurrentRow = 2
End Sub

Private Sub cmdLast_Click()
    CurrentRow = rData.Rows.Count + 1
End Sub

Private Sub cmdSearch_Click()
    Dim ws As Worksheet
    Dim lr As Long
    Set ws = Sheets("Sheet1")
    lr = ws.Cells(Rows.Count, 1).End(xlUp).Row

    If txtConDay = "" Then
        MsgBox "Please input a Contract Day to search a record.", vbExclamation, "CA Contract Day Please!"
        Exit Sub
    End If

    If WorksheetFunction.CountIf(ws.Columns(1), txtConDay) = 0 Then
        MsgBox "The Contract Day you entered doesn't exist. Please try again...", vbExclamation, "Not Found!"
        Exit Sub
    End If
    r = WorksheetFunction.Match(Val(txtConDay), ws.Columns(1), 0)
    CurrentRow = r
    Me.txtDay = ws.Cells(r, "B")
    Me.txtDate = ws.Cells(r, "C")
    Me.txtStd = ws.Cells(r, "D")
    Me.txtAtd = ws.Cells(r, "E")
    Me.txtPerf = ws.Cells(r, "F")
    Me.txtRate = ws.Cells(r, "G")
    Me.txtPenalty = ws.Cells(r, "H")

End Sub

Private Sub cmdUpdate_Click()
    Dim ws As Worksheet
    Dim Ans As String
    Set ws = Sheets("Sheet1")

    If txtConDay = "" Then
        MsgBox "The Contract Day TextBox is empty, so no record can be updated in this case." & vbNewLine & _
               "Please try again.....", vbExclamation, "Not Found!"
        Exit Sub
    End If
    If WorksheetFunction.CountIf(ws.Columns(1), txtConDay) = 0 Then

        r = WorksheetFunction.Match(Val(txtConDay), ws.Columns(1), 0)


        ws.Cells(r, "B") = Me.txtDay
        ws.Cells(r, "C") = Me.txtDate
        ws.Cells(r, "D") = Me.txtStd
        ws.Cells(r, "E") = Me.txtAtd
        ws.Cells(r, "F") = Me.txtPerf
        ws.Cells(r, "G") = Me.txtRate
        ws.Cells(r, "H") = Me.txtPenalty

    End If
End Sub


Sub From_Excel_to_Word_AppendData()
'Dim wordApp As Word.Application
'Dim wordDoc As Word.Document

    Const wdStory = 6
    Const wdMove = 0
    Dim wdApp As Object
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True
    Set wddoc = wdApp.Documents.open("<path>")
    wdApp.Selection.WholeStory
    wdApp.Selection.Delete
    Set wddoc = "G:\Test Reports\Test_Report.docx"
    Dim wdTo As Object
    Set wdTo = wdApp.Selection
    wdTo.EndKey wdStory, wdMove
    wdTo.TypeParagraph
    Dim rng As Range
    Set rng = ("Sheet1, Table1")
    rng.Copy

    wdTo.TypeParagraph
    wdApp.Selection.PasteExcelTable False, False, False
    'commented out, changed the way it pasted the values to word.
    'wdTo.PasteSpecial Link:=False, DataType:=20, Placement:=wdInLine, DisplayAsIcon:=False

    Application.CutCopyMode = False
    wddoc.Save
    wdApp.Activate
End If
End Sub


Private Sub UserForm_Initialize()
    Dim lr As Long
    Set rData = Sheet1.Range("A3").CurrentRegion
    CurrentRow = 4
    txtConDay.SetFocus

    Set ws = Sheets("Sheet1")
    lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
    lblNextConDay = ws.Cells(lr, 1) + 1

    'txtDate.Text = Format(Now(), "Short Date")
    'txtDate.Text = Format(Now(), "Long Date")
    'txtDate.Text = Format(Now(), "dd mmm, yyyy")
    'txtDate.Text = Format(Now(), "mmmm")
    txtDate = Format(txtDate, "dd mmmm yyyy")
    'txtPerf = Format(Performance, "Percent"
    txtPerf = Format(txtPerf, "0.00%")
    'txtRte = Format(Rate, "Percent")
    txtRate = Format(txtRate, "0.00%")
    'txtPen = Format(Penalty, "Percent")
    txtPenalty = Format(txtPenalty, "#,##0.00")

End Sub
Private Sub cbRun_Click()
Dim Reports As Control

For Each Reports In UserForm1.Controls
    If UserForm1.optBut1.Value = True Then
        Application.Dialogs(xlDialogPrint).Show
    Else
    If UserForm1.optBut2.Value = True Then
    If Me.cbRun = True Then
    Me.PrintForm
Exit Sub
End If
End If
End If
Next
End Sub

Private Sub DTPicker1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    On Error Resume Next
    Me.DTPicker1 = CDate(Me.DTPicker1)
    'Dim YourMsg As String
    If DTPicker1.Value < DateSerial(2015, 9, 12) And DTPicker2.Value > DateSerial(2034, 9, 11) Then
        If DTPicker1 = DTPicker2 Then
            msg "For Monthly Reports Select FROM the 1st day TO the last day of the required Period "
            MsgBox YourMsg, vbCancel + vbExclamation

        End If
        Debug.Print
    End Sub
Private Sub cmdQuit_Click()
    Unload UserForm1
End Sub

Open in new window


Database Screenshot
Any tips and advice and assistance on where I have gone wrong  would be much appreciated!
Paul
0
Comment
Question by:Paul Clayton
2 Comments
 
LVL 17

Accepted Solution

by:
Roy_Cox earned 500 total points
ID: 41894563
Have you got formulas in place for the calculations. If you gave convert the database to a Table then all formulas will copy down

Overview of Excel

For better help attach an example workbook.Tables


I'm not sure how this line is working

 
Set rng = ("Sheet1, Table1")

Open in new window

0
 

Author Closing Comment

by:Paul Clayton
ID: 41894626
Combined solution with another query
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

910 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now