If I understand...

Dim myPrefixes as variant
Dim myAddresses as variant
dim myRng as range
dim pCtr as long

myprefixes = array("Dept", "Graph") 'and keep going
'dept, graph
myaddresses = array("A1:C1","x1:z1") 'and keep going

If ubound(myaddresses) < ubound(myprefixes) then
msgbox "Design error!!!!"
exit sub
end if

for pctr = lbound(myprefixes) to ubound(myprefixes)
set myrng = activecell.entirerow.range(myaddresses(pctr))
if me.controls("chk" & myprefixes(pctr) & "prod").value = true then
with myrng
.cells(1) = me.controls("dtp" & myprefixes(pctr) & "prod").value
.cells(2) = me.controls("tbx" & myprefixes(pctr) & "prodesthrs).text
....


(Untested, uncompiled--watch for typos.)

Since each department is laid out the same (3 columns wide, no gaps), you don't
actually have to specify each range.

You could use:

Dim myPrefixes as variant
dim myRng as range
dim pCtr as long

myprefixes = array("Dept", "Graph") 'and keep going

If ubound(myaddresses) < ubound(myprefixes) then
msgbox "Design error!!!!"
exit sub
end if

'whereever it starts
Set myrng = activecell.entirerow.range("a1").resize(1,3)

for pctr = lbound(myprefixes) to ubound(myprefixes)
if me.controls("chk" & myprefixes(pctr) & "prod").value = true then
with myrng
.cells(1) = me.controls("dtp" & myprefixes(pctr) & "prod").value
.cells(2) = me.controls("tbx" & myprefixes(pctr) & "prodesthrs).text
....

end if

'get ready for next time...
set myrng = myrng.offset(0,3)
next pctr



RyanH wrote:

Thanks for all the tips! Got it too work just fine. And of course like
always I have a follow up question:

This code is located in a CommandButton_Click event. I have to copy and
change the following code for all 17 departments we have.

' Graphics Production
Set rngDept = ActiveCell.EntireRow.Range("A1:C1")
If chkGraphProd = True Then
With rngDept
.Cells(1) = dtpGraphProd
.Cells(2) = tbxGraphProdEstHrs.Text
.Cells(3) = tbxGraphProdActHrs.Text
If chkGraphProdDone = True Then
.Font.ColorIndex = 15
Else
.Font.ColorIndex = xlAutomatic
End If
End With
Else
rngDept.ClearContents
End If


Is there a way to loop through all the different departments? I have a
CheckBox1, DTPicker, CheckBox2, TextBox1 and TextBox2 for each dept. Each
controls name is the same except the "Dept" part. So I guess I would need a
way to insert the dept name each loop. Is this possible? Or would it be
better to create a collection of 17 Checkboxs, then another collection for 17
DTPickers, and so on. Then use this CollectionName.Item(i) in a For...Next
Loop.

' Dept Name
' each dept has 3 Columns, 1 for a date, 2 for text, 3 for text
' rngDeptRange would need to shift 3 Columns to the right each loop
Set rngDeptRange = ActiveCell.EntireRow.Range("A1:C1")
If chkDeptCheckBox1 = True Then
With rngDeptRange
.Cells(1) = dtpDeptDTPicker
.Cells(2) = tbxDeptTextBox1.Text
.Cells(3) = tbxDeptTextBox2.Text
If chkDeptCheckBox2 = True Then
.Font.ColorIndex = 15
Else
.Font.ColorIndex = xlAutomatic
End If
End With
Else
rngDeptRange.ClearContents
End If
--
Cheers,
Ryan

"Rick Rothstein" wrote:

Remove the "dots" from in front of the .rngEngineering(1),
..rngEngineering(2), etc... rngEngineering doesn't "belong" to the
Worksheet... it is an object created in memory that is assigned a reference
from an object on the worksheet. With that in mind, I would add "dots" in
front of your Cells property calls in the Set assignment statement as Don
indicated in his post (probably not required for where I think you have your
code located, but always a good practice to follow).

--
Rick (MVP - Excel)


"RyanH" wrote in message
...
I have a named range that I Set as an object. The range is made up of 3
cells all on the same row. Can I change the value of the first, second,
and
third cell of that named range? For example,

Private Sub TestRange()

Dim rngEngineering As Range

With Sheets("Global Schedule")
' Engineering
If chkEngineering = True Then
Set rngEngineering = .Range(Cells(ActiveCell.Row, "T"),
Cells(ActiveCell.Row, "V"))
.rngEngineering(1) = dtpEngineering
.rngEngineering(2) = tbxEngineeringEstHrs.Text ' use .Text to
avoid cell error: Number Stored as Text
.rngEngineering(3) = tbxEngineeringActHrs.Text ' use .Text to
avoid cell error: Number Stored as Text
' change font color to black if not done, grey if done
If chkEngineeringDone = True Then
.rngEngineering.Font.ColorIndex = 15
Else
.rngEngineering.Font.ColorIndex = xlAutomatic
End If
Else
.rngEngineering.ClearContents ' remove from schedule if false
End If
End With

--
Cheers,
Ryan



--

Dave Peterson