শুক্রবার, ১৫ জুলাই, ২০১৬

moddata

Option Explicit
' Developed by Md Robiul awal.
' Mobile : 01748340718

Sub StartNewRecord()
   Dim inputWks As Worksheet
   Dim listWks As Worksheet
   Dim rngClear As Range
   Dim rngNext As Range
   Dim rngID As Range
 
   Set inputWks = Worksheets("Input")
   Set listWks = Worksheets("LookupLists")
 
   Set rngClear = inputWks.Range("DataEntryClear")
   Set rngID = inputWks.Range("IDNum")
   Set rngNext = listWks.Range("NextID")
 
   rngClear.ClearContents
   rngID.Value = rngNext.Value
 
   inputWks.Activate
   rngID.Offset(1, 0).Activate

End Sub

Sub UpdateLogWorksheet()

    Dim historyWks As Worksheet
    Dim inputWks As Worksheet

    Dim nextRow As Long
    Dim oCol As Long

    Dim myCopy As Range
    Dim myTest As Range
   
    Dim lRsp As Long

    Set inputWks = Worksheets("Input")
    Set historyWks = Worksheets("MasterData")
    oCol = 3 'order info is pasted on data sheet, starting in this column
   
    'check for duplicate order ID in database
    If inputWks.Range("CheckID") = True Then
      lRsp = MsgBox("IMP - Number already Exit.Please Check?", vbQuestion + vbYesNo, "Duplicate ID")
      If lRsp = vbYes Then
        UpdateLogRecord
      Else
        MsgBox "Please change IMP Number to a unique number."
      End If
   
    Else
   
    'cells to copy from Input sheet - some contain formulas
    Set myCopy = inputWks.Range("OrderEntry")

    With historyWks
        nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    End With

    With inputWks
          'mandatory fields are tested in hidden column
        Set myTest = myCopy.Offset(0, 2)

        If Application.Count(myTest) > 0 Then
            MsgBox "Please fill in all the cells!"
            Exit Sub
        End If
    End With


    With historyWks
          'enter date and time stamp in record
        With .Cells(nextRow, "J")
            .Value = Now
            .NumberFormat = "dd/mm/yyyy"
        End With
       
       
         'enter date and time stamp in record
        With .Cells(nextRow, "L")
            .Value = Now
            .NumberFormat = "hh:mm:ss"
        End With
        'enter user name in column B
        .Cells(nextRow, "A").Value = Application.UserName
       
          'enter user name in column B
        .Cells(nextRow, "K").Value = Application.UserName
       
          'copy the order data and paste onto data sheet
        myCopy.Copy
        .Cells(nextRow, 3).PasteSpecial Paste:=xlPasteValues, Transpose:=True
        Application.CutCopyMode = False
    End With
   
    'clear input cells that contain constants
    With inputWks
      On Error Resume Next
         With myCopy.Cells.SpecialCells(xlCellTypeConstants)
              .ClearContents
              Application.GoTo .Cells(1) ', Scroll:=True
         End With
      On Error GoTo 0
    End With
End If
End Sub
Sub UpdateLogRecord()

    Dim historyWks As Worksheet
    Dim inputWks As Worksheet

    Dim lRec As Long
    Dim oCol As Long
    Dim lRecRow As Long

    Dim myCopy As Range
    Dim myTest As Range
   
    Dim lRsp As Long
   
    Set inputWks = Worksheets("Input")
    Set historyWks = Worksheets("MasterData")
    oCol = 3 'order info is pasted on data sheet, starting in this column
   
    'check for duplicate order ID in database
    If inputWks.Range("CheckID") = False Then
      lRsp = MsgBox("IMP Number not in Master data. Add record?", vbQuestion + vbYesNo, "New Order ID")
      If lRsp = vbYes Then
        UpdateLogWorksheet
      Else
        MsgBox "Please select IMP Number that is in the Master Data."
      End If
   
    Else
       
    'cells to copy from Input sheet - some contain formulas
    Set myCopy = inputWks.Range("OrderEntry")

    lRec = inputWks.Range("CurrRec").Value
    lRecRow = lRec + 1

    With inputWks
        Set myTest = myCopy.Offset(0, 2)

        If Application.Count(myTest) > 0 Then
            MsgBox "Please fill in all the cells!"
            Exit Sub
        End If
    End With

    With historyWks
        With .Cells(lRecRow, "J")
            .Value = Now
            .NumberFormat = "dd/mm/yyyy"
        End With
       
       
       
       
       
        .Cells(lRecRow, "K").Value = Application.UserName
        oCol = 3
   
   
        myCopy.Copy
        .Cells(lRecRow, 3).PasteSpecial Paste:=xlPasteValues, Transpose:=True
        Application.CutCopyMode = False
    End With
   
    'clear input cells that contain constants
    With inputWks
      On Error Resume Next
         With myCopy.Cells.SpecialCells(xlCellTypeConstants)
              .ClearContents
              Application.GoTo .Cells(1) ', Scroll:=True
         End With
      On Error GoTo 0
      If .Range("ShowMsg").Value = "Yes" Then
         MsgBox "Master data has been updated."
      End If
    End With
  End If
End Sub

Sub DeleteLogRecord()

    Dim historyWks As Worksheet
    Dim inputWks As Worksheet

    Dim lRec As Long
'    Dim oCol As Long
    Dim lRecRow As Long
    Dim lDel As Long
    Dim strOrder As String

    Dim myCopy As Range
    Dim myTest As Range
   
    Set inputWks = Worksheets("Input")
    Set historyWks = Worksheets("MasterData")
       
    strOrder = inputWks.Range("OrderSel").Value
    lRec = inputWks.Range("CurrRec").Value
    lRecRow = lRec + 1
           
    'cells to clear after deleting record
    Set myCopy = inputWks.Range("OrderEntry")
   
    lDel = MsgBox("Delete IMP- " & strOrder & "?", vbCritical + vbYesNo, "Delete IMP-")
    If lDel = vbYes Then
        With historyWks
            With .Cells(lRecRow, "A")
                Application.DisplayAlerts = False
                .EntireRow.Delete
                Application.DisplayAlerts = True
            End With
        End With
   
        'clear input cells that contain constants
        With inputWks
          On Error Resume Next
             With myCopy.Cells.SpecialCells(xlCellTypeConstants)
                  .ClearContents
                  Application.GoTo .Cells(1) ', Scroll:=True
             End With
          On Error GoTo 0
        End With
    Else
        MsgBox "Delete Success"
    End If
End Sub


কোন মন্তব্য নেই:

একটি মন্তব্য পোস্ট করুন