Force no empty cell depending on another cell in Excel

Question

is it possible in Excel to force a no empty cell depending on another cell? I mean if you type in e.g. a casenumber in A1, then you have to type in something in B1 and C1 also. And it should be dynamic, so it should Work on all the cells in column B and C, but it should only look at the cell in the same row in column A.

Just some more details....

Because the original sheets isn't designed to be exported, I need to copy the appropiate data to another sheet before exporting.

So I have a ungly sheets which filled out cell I copy to a nicer layout on another sheet, which in turn I export to csv.

I use this code to copy the data:

Private Sub CopyAllNonBlanksInRange() With Sheets("Flexhal Tilbudsregistrering") .Columns("E").SpecialCells(xlCellTypeConstants).Copy Destination:=Sheets("Ark1").Range("A1") .Columns("F").SpecialCells(xlCellTypeConstants).Copy Destination:=Sheets("Ark1").Range("B1") .Columns("G").SpecialCells(xlCellTypeConstants).Copy Destination:=Sheets("Ark1").Range("C1") End With end sub

So the problem is in the copy process, as it as it should only copies the cells which contains data.

At this point I can only see that I have to run through all row to check if they are filled out and do the copy based on that. That seems like a mess, and I'm not even sure of how to do that.

Answer 1

This can be accomplished with an Event macro The macro would enforce this scenario:

1. start with all cells protected except A1
2. once the user has filled A1, both B1 and C1 become un-protected
3. once the user has filled both B1 and C1, A2 become un-protected

etc.

EDIT#1

First enter and run this macro to setup the sheet:

Sub SETUPP()
    ActiveSheet.Unprotect
    Application.EnableEvents = False
    Cells.Clear
    Cells.Locked = False
        With Range("A1")
            .Select
            Cells.Locked = True
            .Locked = False
        End With
    ActiveSheet.Protect
    Application.EnableEvents = True
End Sub

Then enter this Event macro in the worksheet code area:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, N As Long
Set A = Range("A:A")
N = Target.Row
If Not Intersect(Target, A) Is Nothing Then
    ActiveSheet.Unprotect
        Target.Offset(0, 1).Select
        Cells.Locked = True
        Range("B" & N & ":C" & N).Locked = False
    ActiveSheet.Protect
Else
    If Application.WorksheetFunction.CountA(Range("B" & N & ":C" & N)) = 2 Then
        ActiveSheet.Unprotect
            Range("A" & N + 1).Select
            Cells.Locked = True
            Range("A" & N + 1).Locked = False
        ActiveSheet.Protect
    End If
End If
End Sub

Because it is worksheet code, it is very easy to install and automatic to use:

1. right-click the tab name near the bottom of the Excel window
2. select View Code - this brings up a VBE window
3. paste the stuff in and close the VBE window

If you have any concerns, first try it on a trial worksheet.

If you save the workbook, the macro will be saved with it. If you are using a version of Excel later then 2003, you must save the file as .xlsm rather than .xlsx

To remove the macro:

1. bring up the VBE windows as above
2. clear the code out
3. close the VBE window

To learn more about macros in general, see:

http://www.mvps.org/dmcritchie/excel/getstarted.htm

and

http://msdn.microsoft.com/en-us/library/ee814735(v=office.14).aspx

To learn more about Event Macros (worksheet code), see:

http://www.mvps.org/dmcritchie/excel/event.htm

Macros must be enabled for this to work!

Answer 2

@gary's I'm sure your answear is valid, but since last I managed to solved it myself through this code:

Dim celleværdi As String
Dim i As Long
Dim række As Long
Dim startcelle As String
række = 1
nederstecelle = "E65000"

Range(nederstecelle).End(xlUp).Select 'ud fra variblen celle finder vi den sidste celle med værdi i
sidstecelle = ActiveCell.Row
'MsgBox sidstecelle

For i = 1 To sidstecelle 'looper kun igennem rækkerne indtil sidste udfyldte celle
    If Cells(i, 5).Value <> "" Then 'er celleværsien forskellig fra tom, så kopiere den over i Ark2
         Cells(i, 5).Select
         Range(ActiveCell, ActiveCell.Offset(0, 2)).Copy Destination:=Sheets("Ark1").Cells(række, 1)
         række = række + 1
     End If
Next i

And you code seems a little to much overkill for the task. I still get the empty cells, but now the get copied as they should, then maybe I'll do some checking and paste in my own text if a cell is empty.

But thank for the help, if I haven't solved it my selv, I'm sure it would have helped me.