Kan tvinge udfyldes af et felt, hvis data i et andet.

Kan du ikke bruge drop-down-listen fra kontrolelementer?
/hpo

sorry - det bliver jo noget med nogle betingelser også. læste vist ikke ordentligt i første omgang. Se bort fra mit indlæg.

prøv indsæt i arkets kodemodul:
(linie 2 tester for input i a2:b20 ret efter behov)

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a2:b20")) Is Nothing Then Exit Sub
  Dim i
  For i = 2 To Target.Row - 1
    If Cells(i, 3) = "" Then Target = "": Cells(i, 3).Select: Exit Sub
  Next
End Sub

eller: (messagebox til/fravælges efter temperament)

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a2:b20")) Is Nothing Then Exit Sub
Cells(Target.Row, 3).Select
If ActiveCell.Row > Cells(2, 3).End(xlDown).Offset(1, 0).Row Then
Cells(2, 3).End(xlDown).Offset(1, 0).Select
MsgBox ("Husk at vælge måned ")
End If
End Sub

Har prøvet den sidste med messagebox, men modtager en fejl meddelse som følgende
"Compiler Error, End if Without block if"
Og kan dermed ikke tjekke om den virker når jeg vælger data i celle 3.
Nogle hints.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:B")) Is Nothing Then
    If Target.Column = 1 Then
        Cells(Target.Row, 2).Activate
    End If
    If Target.Column = 2 Then
        Cells(Target.Row, 3).Activate
    MsgBox "Indtast måned"
    End If
End If
End Sub

prøv lige

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a2:b20")) Is Nothing Then Exit Sub
Cells(Target.Row, 3).Select
If Cells(2, 3) = "" Then Cells(2, 3).Select: Exit Sub
If ActiveCell.Row > Cells(1, 3).End(xlDown).Offset(1, 0).Row Then
Cells(2, 3).End(xlDown).Offset(1, 0).Select
MsgBox ("Husk at vælge måned ")
End If
End Sub

Eller prøv denne. Den tvinger en indtastning igennem i C kolonnen

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:C")) Is Nothing Then
Target.Offset(, 1).Activate
    If Target.Column = 2 Then
        MsgBox "Indtast måned"
    End If
    If Target.Column = 3 And Target.Value = "" Then
        Target.Activate
        MsgBox "Om igen"
        SendKeys ("{F2}")
        On Error Resume Next
    End If
End If
End Sub

sidste bud. :-)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Column > 4 Then Exit Sub
If ActiveCell.Column = 4 Then
ActiveCell.Offset(0, -1).Select
MsgBox (" Måned skal udfyldes")
End If
If Range("C20").End(xlUp).Row < Range("A20").End(xlUp).Row Or _
Range("C20").End(xlUp).Row < Range("B20").End(xlUp).Row Then _
Cells(Range("C20").End(xlUp).Row + 1, ActiveCell.Column).Select
End Sub

Hej Alle.

Den der virker bedst med et lille tweak var fra mrhj, og blev sådan.
Dog har forslaggene fra excelent, gjort at jeg kunne forbedre arket på andre måder, og derfor deler jeg point med 40 point til mrhj og 20 til execelent.
Tak for hjælpen.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:B")) Is Nothing Then
    If Target.Column = 1 Then
        Cells(Target.Row, 3).Activate
    MsgBox "Indtast måned"
    End If
    If Target.Column = 2 Then
        Cells(Target.Row, 3).Activate
    MsgBox "Indtast måned"
    End If
End If
End Sub

Hej Igen.

Hvordan tildeler man point, kan ikke se hvor jeg kan gøre dette.

Kristian

.

Når vi har lagt et svar, kan du finde os :-). Vent til excelent svarer.

ok, jeg opretter en ny da jeg skal have dette gentaget over mange kolonner og det virkede ikke lige som jeg forventede. Se nyt sprøgsmål fra mig om 5 min.

Hej
Mrjh og Excelent, venligst svar på mit nye spørgsmål - Point for "Kan tvinge udfyldes af et felt, hvis data i et andet."

Så tildeler jeg point som lovet, beklager besvaret.

Kristian