Posts by muggi

Private Sub Worksheet_Change(ByVal Target As Range)
  LR = Range("B" & Rows.Count).End(xlUp).Row
  Set Rng = Range("B14:B" & LR)
  If Target.Address = "$G$4" Then
    Set c = Rng.Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
        Range("G4").Copy Cells(c.Row, 7)
    End If
  End If
  If Target.Address = "$I$4" Then
    Set c = Rng.Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
        Range("I4").Copy Cells(c.Row, 9)
    End If
  End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  LR = Range("B" & Rows.Count).End(xlUp).Row
  Set Rng = Range("B14:B" & LR)
  If Target.Address = "$G$4" Then
    Set c = Rng.Find(Target.Value, LookIn:=xlValues)
    If Not c Is Nothing Then
        Range("G4").copy Cells(c.Row, 7)
    End If
  End If
  If Target.Address = "$I$4" Then
    Set c = Rng.Find(Target.Value, LookIn:=xlValues)
    If Not c Is Nothing Then
        Range("I4").copy Cells(c.Row, 9)
    End If
  End If


End Sub

Private Sub CommandButton1_Click()
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
' forsæt ved fejl
'On Error Resume Next
Dim Cell As Range
Dim Checkrange As Range
Dim TValue As Variant
  


'Do nothing if more than one cell is changed or content deleted
   If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
      
    If Target.Address = "$G$4" Then
       'Ensure target is a number before multiplying by 2
        'If IsNumeric(Target) Then
            'Stop any possible runtime errors and halting code
          ' On Error Resume Next
                'Turn off ALL events so the Target * 2 does not _
                 put the code into a loop.
       '  If Not Intersect(Target, Range("g4,i4")) Is Nothing Then
                 
                Range("G4").Select
                Selection.copy
                
                Application.EnableEvents = False
                'Target = Target * 2
                If Target.Value >= 1 Then
                Call SoegOgMarker
                End If
                'Turn events back on
                Application.EnableEvents = True
            'Allow run time errors again
            On Error GoTo 0
        
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Application.CutCopyMode = False
        End If
    'End If


End Sub

Sub SoegOgMarker()
    Dim LedEfter As String
    Static Sidste As String
   ' Sidste = ActiveCell.Offset(0, -1).Address
    LedEfter = Range("g4").Value
   ' Range(Sidste).Offset(1, 0).Activate
    Cells.Find(what:=LedEfter, After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Offset(0, 5).Activate
   ' Sidste = ActiveCell.Offset(0, 2).Address
    End Sub