Code to fill cells with check box or data entry

[Jr66]

Hello

See attached, is there some way to have cells filled when check box entered but if check box not checked can enter data into cell

Thanks Jeff

[dflak]

Right click on the box and assign this macro

Please Login or Register  to view this content.

[Jr66]

When I put in my actual sheet I get subscript out of range error, any chance if I send you my sheet you can have a look

[dflak]

Check this line: Set sh = Sheets("Sheet1") make sure your actual sheet name is between the quotes.

[Jr66]

Ok I got it to work for 1st set, now I want to add 2 more of the same in different spots.

I have put 1st one in module 3, where do i put the rest

This is the one that works

Sub Change_Box()
Dim sh As Worksheet

Set sh = Sheets("DRIFLO")

If sh.Range("$q$16") = True Then
' Fill Cells
sh.Range("$I$17:$I$28").Copy Range("$m$17")
Else
' Clear Contents
sh.Range("$m$17:$m$28").ClearContents

End If

End Sub


Here are the next 2 I want to add

Have[/B] to work independent of each other[/B]

Sub Change_Box()
Dim sh As Worksheet

Set sh = Sheets("DRIFLO")

If sh.Range("$q$32") = True Then
' Fill Cells
sh.Range("$i$34:$i$39").Copy Range("$m$34")
Else
' Clear Contents
sh.Range("$m$34:$m$39").ClearContents
End If

End Sub



Sub Change_Box()
Dim sh As Worksheet

Set sh = Sheets("DRIFLO")

If sh.Range("$q$44") = True Then
' Fill Cells
sh.Range("$g$46:$g$48").Copy Range("$m$46")
Else
' Clear Contents
sh.Range("$g$46:$m$48").ClearContents
End If

End Sub


THANK YOU ALL FOR YOUR HELP

[dflak]

Give each one of these macros a different name. Then right click on the checkbox - one of the options is Assign Macro. Pick the macro that goes along with that checkbox.

[Jr66]

OK making progress, I got that spreadsheet done.

Moved to next sheet and when i debug it goes here

Set sh = Sheets("ELECTRONIC EFM")

This is what sheet is called

ELECTRONIC EFM

Whjat else would make this fail?


Here is code

Sub Change_Box()
Dim sh As Worksheet

Set sh = Sheets("ELECTRONIC EFM")

If sh.Range("$q$16") = True Then
' Fill Cells
sh.Range("$I$27:$I$32").Copy Range("$m$27")
Else
' Clear Contents
sh.Range("$m$27:$m$32").ClearContents

End If

End Sub

[Jr66]

Never mind figured that out.

But now with one check box I want to copy f48 to f50 as well as g48 to G50 over to k48 to k50 and m48 to m50

Code I used for single row, now I need multiple row see bold

Sub CheckBox283_Click()

Dim sh As Worksheet

Set sh = Sheets("ELECTRONIC EFM")

If sh.Range("$q$24") = True Then
' Fill Cells
sh.Range("$I$36:$I$41").Copy Range("$m$36")
Else
' Clear Contents
sh.Range("$m$36:$m$41").ClearContents

End If

End Sub

Thanks in advance fo rhrlp

[Jr66]

Got it. Thanks