Forcing user to enter data in two cells if another is populated using VBA

[Matt Young]

Afternoon all

This is only my second post so appologiese if this is inthe wrong place.

I am curently in the final stages of creating a spread sheet for documenting multiple bakup of multiple devces. as the spreadsheet is stored on a pc which is never going to be connected to the internet I need a way to force the user to input their details before either moving onto the next cell or saving the sheet I have tried VBA but I cannot get t to work. This iswhat I ave so far. Nte "FTD1"s my sheet name

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim KeyCells As Range
    Dim Check1 As Integer
    
    Set KeyCells = Range("C3:C35")
    
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _Is Nothing Then
        If Not Target.Value = "" Then
        thisrow = Target.Row
        firstcheck = ("F3:F35")
        SecondCheck = ("E3:E35")

        myvalue = ThisWorkbook.Worksheets("FTD1").Range("F3:F35").Value
        myvalue2 = ThisWorkbook.Worksheets("FTD1").Range(SecondCheck).Value
        If myvalue = "" Or myvalue2 = "" Then
            MsgBox "Please enter initials and locationof backup"
             End If
             
        End If

       
    End If
End Sub

Thanks in advance

 

[Kamolga]

Hi,

I am not sure to understand. The easiest is to force user to insert value wen he change values in column C. If I understant it well, you need data in column E and F same row. So for example, with this code, if user put 3 in C5 and column E is empty, it will tell user to put initials, deletete the 3 amd go to E5 to imput his initials. If then he puts 3 again in C5, it will tell him to put location in F5, delete the 3 again and go to f5 for input. If now he puts 3, nothing happen.

Right click FTD1 name, click view code and paste

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim KeyCells As Range
 Set KeyCells = Range("C3:C35")
    
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
        If Not Target.Value = "" Then
            If Cells(Target.Row, "E") = "" Then
                MsgBox "Please enter initials"
                Target.ClearContents
                Cells(Target.Row, "E").Select
                Exit Sub
            End If
             If Cells(Target.Row, "F") = "" Then
                MsgBox "Please enter backup location"
                Target.ClearContents
                Cells(Target.Row, "F").Select
                Exit Sub
            End If
        End If
    End If
End Sub

so C5 will stay empty as long as E5 and F5 are not filled (idem C6,C7,etc)

 

[mikerickson]

That looks like it was put in the ThisWorkbook code module.

This goes in the code module for sheet FTD1, not ThisWorkbook

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim targetRange As Range
    Set targetRange = Me.Range("C3:C35")
    
    With Target
        If .Cells.Count = 1 Then
            If Not Application.Intersect(.Cells, targetRange) Is Nothing Then
                If .Value <> vbNullString Then
                    With .EntireRow.Range("F1")
                        Do Until .Value <> vbNullString
                            .Value = InputBox("Enter Initials")
                        Loop
                    End With
                    With .EntireRow.Range("E1")
                        Do Until .Value <> vbNullString
                            .Value = InputBox("Enter Backup Location")
                        Loop
                    End With
                End If
            End If
        End If
    End With
End Sub