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
' 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
কোন মন্তব্য নেই:
একটি মন্তব্য পোস্ট করুন