Hi, santosh226001,
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("K107,F2,a24,a44,a54,a64,a74,a84")) Is Nothing Then Exit Sub
Dim r As Range, i As Long, lngFF As Long
Set r = Sheets("Roadlist").Columns(2).Find(Range("F2").Value, lookat:=xlWhole)
If r Is Nothing Then
MsgBox "not found " & Range("F2").Value, 64
Exit Sub
End If
' check with Roadlist sheet that road if already enter
If r(1, 8) = "Enter" Then
MsgBox r & " Data already Enter..", 64
Exit Sub
End If
Select Case Target.Address(0, 0)
Case "F2"
Sheets("Entry").Unprotect Password:="san"
Application.EnableEvents = False
Range("k2").Value = r(1, 2)
If r(1, 4) <= 20 Then Rows("26:104").Hidden = True
Application.EnableEvents = True
Sheets("Entry").Protect Password:="san"
' Application.StatusBar = "This is msg box"
Case "K107"
If Target.Text = "N" Then MsgBox "You Choose No .. so NO Record Post": Exit Sub
If MsgBox("Are you Sure You Want to Save Entered Road Record?", vbYesNo, _
"Confermation Yes or Not") = vbNo Then Exit Sub
If Range("m106").Value <> "Data Ok" Then MsgBox "Data Not Correct... See Row Number 106 for Errors!!": Exit Sub
' copy prarup1
With Sheets("Prarup-1")
lngFF = .Cells(Rows.Count, 2).End(xlUp)(2).Row
With .Cells(lngFF, "B").Resize(101, 21)
.Parent.Visible = -1
.Value = Range("A115:U215").Value
.Range("J115:M215").Copy
Sheets("Prarup-1").Cells(lngFF, "K").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.Cells(.Rows.Count, 8).Resize(, 6).FormulaR1C1 = "=SUM(R[" & 1 - .Rows.Count & "]C:R[-1]C)"
On Error Resume Next
For i = .Rows.Count To 1 Step -1
If .Rows(i).Text = vbNullString Then .Rows(i).EntireRow.Delete
Next i
On Error GoTo 0
.Offset(, -1).Resize(, 12).Borders.LineStyle = xlContinuous
End With
End With
' copy to prarup2
With Sheets("Prarup-2").Cells(Rows.Count, 2).End(xlUp)(2).Resize(, 137)
.Value = Range("A111:EG111").Value
.Offset(, -1).Resize(, 52).Borders.LineStyle = xlContinuous
End With
Application.EnableEvents = False
Target.Value = "N"
' copy workbook after each entry record
' ActiveWorkbook.Save
Sheets("Entry").Unprotect Password:="san"
Range("F2:i2,k2").ClearContents: Range("A5:j104").SpecialCells(2).ClearContents
Sheets("Entry").Protect Password:="san"
Sheets("Prarup-2").Visible = xlVeryHidden
' Range("a5").Select
Application.EnableEvents = True
Case "A24"
Sheets("Entry").Unprotect Password:="san"
Rows("25:44").Hidden = False
Sheets("Entry").Protect Password:="san"
Case "A44"
Sheets("Entry").Unprotect Password:="san"
Rows("45:54").Hidden = False
Sheets("Entry").Protect Password:="san"
Case "A54"
Sheets("Entry").Unprotect Password:="san"
Rows("55:64").Hidden = False
Sheets("Entry").Protect Password:="san"
Case "A64"
Sheets("Entry").Unprotect Password:="san"
Rows("65:74").Hidden = False
Sheets("Entry").Protect Password:="san"
Case "A74"
Sheets("Entry").Unprotect Password:="san"
Rows("75:84").Hidden = False
Sheets("Entry").Protect Password:="san"
Case "A84"
Sheets("Entry").Unprotect Password:="san"
Rows("85:104").Hidden = False
Sheets("Entry").Protect Password:="san"
End Select
End Sub
CIao,
Holger
Bookmarks