Reputation: 57
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.
Upvotes: 0
Views: 1117
Reputation: 57
@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.
Upvotes: 0
Reputation: 96781
This can be accomplished with an Event macro The macro would enforce this scenario:
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:
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:
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!
Upvotes: 0