Snasui Excel Forum

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range
    Dim rCheck As Range
    Dim ColAmount As Integer
    Dim ColName As Integer
    Dim lng As Long
    If Target.Count > 1 Then Exit Sub
    If Target.Column = 1 Then
        With Sheets("Sheet2")
            Set rCheck = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
        End With
        With Sheets("Sheet1")
            Set Rng = .Range("A1", .Range("C" & Rows.Count).End(xlUp))
        End With
        ColName = 2
        ColAmount = 3
        lng = Application.CountIf(Rng.Resize(, 1), Target)
        If lng >= 1 Then
            If Application.CountIf(rCheck, Target) > 1 Then
                MsgBox ("Double!!!")
            End If
            Target.Offset(0, 2) = Application.VLookup(Target, Rng, ColAmount, 0)
            Target.Offset(0, 1) = Application.VLookup(Target, Rng, ColName, 0)
        Else
             Target.Font.Color = vbRed
             Target.Font.Bold = True
        End If
    End If
End Sub

Code: Select all

Sub RecordData2()
   Dim lastRow&
    With Sheets("frome")
 
         lastRow = .Range("b" & .Rows.Count).End(xlUp).Row + 1
         .Range("b" & lastRow, .Range("k" & lastRow)).Value = _
            Sheets("frome").Range("b3:k3").Value
    End With
     
     With Sheets("in")
        
        lastRow = .Range("a" & .Rows.Count).End(xlUp).Row + 1
        .Range("a" & lastRow, .Range("k" & lastRow)).Value = _
            Sheets("frome").Range("a3:k3").Value
    End With
End Sub