Jessica45730
New Member
- Joined
- Mar 26, 2010
- Messages
- 2
I have an input sheet, with a button that copies the data to an output sheet and then clears the input sheet.
I want to make some cells in the input sheet mandatory all of the time, and other cells in the sheet mandatory some of the time. For example:
D5, D7, D9 mandatory all of the time
I7, L7 mandatory only if cell D7 equals a specific value
Here is my button macro:
I want to get rid of that "please fill in all of the cells piece", because it doesn't seem to be working properly... and I want to specify rules for specific cells, as I mentioned above.
I want to make some cells in the input sheet mandatory all of the time, and other cells in the sheet mandatory some of the time. For example:
D5, D7, D9 mandatory all of the time
I7, L7 mandatory only if cell D7 equals a specific value
Here is my button macro:
Sub UpdateLogWorksheet()
Dim historyWks As Worksheet
Dim inputWks As Worksheet
Dim nextRow As Long
Dim oCol As Long
Dim myRng As Range
Dim myCopy As String
Dim myCell As Range
'cells to copy from Input sheet - some contain formulas
myCopy = "M15,D5,D7,I7,D9,D11,D13,D15,D17,D19,G19,G15,J15,L15,D21,L7"
Set inputWks = Worksheets("Coverage_Input")
Set historyWks = Worksheets("Coverage_Output")
With historyWks
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With
With inputWks
Set myRng = .Range("M15,D5,D7,I7,D9,D11,D13,D15,D17,D19,G19,G15,J15,L15,D21,L7")
If Application.CountA(myRng) < 8 Then
MsgBox "Please fill in all of the cells!"
Exit Sub
End If
End With
With historyWks
With .Cells(nextRow, "A")
.Value = Now
.NumberFormat = "mm/dd/yyyy"
End With
.Cells(nextRow, "B").Value = Application.UserName
oCol = 3
For Each myCell In myRng.Cells
historyWks.Cells(nextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell
End With
'clear input cells that contain constants
With inputWks
On Error Resume Next
With .Range("D5,D7,I7,D9,D11,D13,D15,D17,D19,G19,G15,J15,L15,D21,L7").Cells.SpecialCells(xlCellTypeConstants)
.ClearContents
Application.GoTo .Cells(1) ', Scroll:=True
End With
On Error GoTo 0
End With
End Sub
Dim historyWks As Worksheet
Dim inputWks As Worksheet
Dim nextRow As Long
Dim oCol As Long
Dim myRng As Range
Dim myCopy As String
Dim myCell As Range
'cells to copy from Input sheet - some contain formulas
myCopy = "M15,D5,D7,I7,D9,D11,D13,D15,D17,D19,G19,G15,J15,L15,D21,L7"
Set inputWks = Worksheets("Coverage_Input")
Set historyWks = Worksheets("Coverage_Output")
With historyWks
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With
With inputWks
Set myRng = .Range("M15,D5,D7,I7,D9,D11,D13,D15,D17,D19,G19,G15,J15,L15,D21,L7")
If Application.CountA(myRng) < 8 Then
MsgBox "Please fill in all of the cells!"
Exit Sub
End If
End With
With historyWks
With .Cells(nextRow, "A")
.Value = Now
.NumberFormat = "mm/dd/yyyy"
End With
.Cells(nextRow, "B").Value = Application.UserName
oCol = 3
For Each myCell In myRng.Cells
historyWks.Cells(nextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell
End With
'clear input cells that contain constants
With inputWks
On Error Resume Next
With .Range("D5,D7,I7,D9,D11,D13,D15,D17,D19,G19,G15,J15,L15,D21,L7").Cells.SpecialCells(xlCellTypeConstants)
.ClearContents
Application.GoTo .Cells(1) ', Scroll:=True
End With
On Error GoTo 0
End With
End Sub
I want to get rid of that "please fill in all of the cells piece", because it doesn't seem to be working properly... and I want to specify rules for specific cells, as I mentioned above.