I have 3 or 4 different categories of parts. Each category will go on a
seperate sheet (Sheet2 thru Sheet4).

I would like to choose parts by clicking a checkbox on the parts that I
want. When I am done, I would like all checked parts to appear on Sheet1.
Is this possible?

Thanks,

Gary

With the ActiveX checkbox, wride your code in the click event. In a forms
check box, assign a proc (macro) to the control.
Easiest would be to use the double click sheet event on each sheet.

"Gary Paris" wrote:

I have 3 or 4 different categories of parts. Each category will go on a
seperate sheet (Sheet2 thru Sheet4).

I would like to choose parts by clicking a checkbox on the parts that I
want. When I am done, I would like all checked parts to appear on Sheet1.
Is this possible?

Thanks,

Gary

Gary,

If you have a lot of parts to select from and/or you will be adding and
deleting parts from the lists then using check boxes will be problematic
because of the need to add/delete the controls etc. Also, ActiveX controls
are notorious for causing problems if you have too many. Check boxes from the
Forms toolbar have a minimum size which may not be small enough and may also
lead to problems if you have too many (assumption on my part).

I think I would forget using controls and use the WorksheetSelection_Change
event to toggle the text of the cells in the columns adjacent each parts
list. If the font style for these cells is set to Marlett, then toggling
between "a" and "" will achieve the desired affect. Note that an "a" in
Marlett font is a check mark.

The advantage of this approach is that you can use Dynamic Named ranges to
reference the cells of each list which will automatically adjust to changes
in the size of the lists. This can hold also for the cells in the adjacent
columns that exhibit the above behaviour - i.e. no maintenance required.

Under the assumption that you are not very familiar with code and Dynamic
Named ranges, I wrote the below elaborate code which you can use to set all
this up. The larger macro is intended to only be used once ON A NEW WORKBOOK
to set it all up including required code. The smaller macro is intended to be
used to update the selected parts list. Note that this code was written just
now with minimal testing and is risky. It is intended as an example only.

Regards,
Greg

Sub SetUp()
'Only run this once in new workbook
Dim ws As Worksheet
Dim c As Range
Dim Code As String
Dim txt1 As String, txt2 As String
Dim Nm As Name
Dim FoundNm1 As Boolean, FoundNm2 As Boolean
Dim checkline As String
Dim i As Integer, ii As Integer
Dim x As Integer, Ln As Long

i = 0: x = 0
FoundNm1 = False: FoundNm2 = False
checkline = "Worksheet_SelectionChange"
Sheets(1).Name = "Selected Parts"
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "Selected Parts" Then
i = i + 1
ws.Name = "List " & i
ws.Cells.RowHeight = 12.75
ws.Columns(1).Locked = False
With ws.Columns(2)
..Locked = True
..ColumnWidth = 2.25
..Font.Name = "Marlett"
..Font.Bold = False
..HorizontalAlignment = xlCenter
..VerticalAlignment = xlCenter
End With
For ii = 1 To 25
x = x + 1
ws.Cells(ii, 1) = "Part " & x
Next
txt1 = "=Offset('" & ws.Name & "'!$A$1, 0, 0, " & _
"CountA('" & ws.Name & "'!$A:$A), 1)"
txt2 = "=Offset(PartsList" & i & ", 0, 1)"
For Each Nm In ThisWorkbook.Names
If Nm.Name = "PartsList" & i Then FoundNm1 = True
If Nm.Name = "CheckList" & i Then FoundNm2 = True
Next
With ThisWorkbook
If Not FoundNm1 Then .Names.Add "PartsList" & i, txt1 _
Else .Names("PartsList" & i).RefersTo = txt1
If Not FoundNm2 Then .Names.Add "CheckList" & i, txt2 _
Else .Names("CheckList" & i).RefersTo = txt2
End With
FoundNm1 = False: FoundNm2 = False
Code = "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" & _
vbCr & "If Target.Count 1 Then Exit Sub" & _
vbCr & "If Not Intersect(Target, Range(""CheckList" & i & """)) Is Nothing
Then" & _
vbCr & "If Target = """" Then" & _
vbCr & "Target = ""a""" & _
vbCr & " Else" & _
vbCr & "Target = """"" & _
vbCr & "End If" & _
vbCr & "End If" & _
vbCr & "End Sub"
With ThisWorkbook.VBProject.VBComponents(ws.CodeName).C odeModule
Ln = .CountOfLines
If Not .Find(checkline, 1, 1, Ln, 1) Then .InsertLines Ln + 1, Code
End With
'ws.Protect UserInterfaceOnly:=True
End If
Next
End Sub

Sub UpdateSelectedParts()
'Use this macro to update selected parts
Dim ws As Worksheet
Dim Nm As Name
Dim rng As Range, c As Range, cc As Range
Dim rw As Long
Dim i As Integer

Set ws = Sheets("Selected Parts")
ws.Columns(1).ClearContents
ws.Range("A1") = "Selected Parts"
Set c = Range("A2")
i = 1
For Each Nm In ThisWorkbook.Names
If Left(Nm.Name, 9) = "PartsList" Then
For Each cc In Range(Nm.Name)
If cc(1, 2) = "a" Then
c(i) = cc
i = i + 1
End If
Next
End If
Next
End Sub

It just occurred to me after the previous post that you can use SpecialCells
instead of Dynamic Named ranges. This will greatly simplify the code. I
suggest you try this instead. Use a new workbook.

Regards,
Greg

Sub SetUp()
'Intended to only run this once in new workbook
Dim ws As Worksheet
Dim c As Range
Dim Code As String
Dim checkline As String
Dim i As Integer, ii As Integer
Dim x As Integer, Ln As Long

i = 0: x = 0
checkline = "Worksheet_SelectionChange"
Sheets(1).Name = "Selected Parts"
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "Selected Parts" Then
i = i + 1
ws.Name = "List " & i
ws.Cells.RowHeight = 12.75
ws.Columns(1).Locked = False
With ws.Columns(2)
..Locked = True
..ColumnWidth = 2.25
..Font.Name = "Marlett"
..Font.Bold = False
..HorizontalAlignment = xlCenter
..VerticalAlignment = xlCenter
End With
For ii = 1 To 25
x = x + 1
ws.Cells(ii, 1) = "Part " & x
Next
Code = "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" & _
vbCr & "Dim rng As Range" & _
vbCr & "If Target.Count 1 Then Exit Sub" & _
vbCr & "Set rng = me.Columns(1).SpecialCells(2).Offset(0,1)" & _
vbCr & "If Not Intersect(Target, rng) Is Nothing Then" & _
vbCr & "If Target = """" Then" & _
vbCr & "Target = ""a""" & _
vbCr & " Else" & _
vbCr & "Target = """"" & _
vbCr & "End If" & _
vbCr & "End If" & _
vbCr & "End Sub"
With ThisWorkbook.VBProject.VBComponents(ws.CodeName).C odeModule
Ln = .CountOfLines
If Not .Find(checkline, 1, 1, Ln, 1) Then .InsertLines Ln + 1, Code
End With
'ws.Protect UserInterfaceOnly:=True
End If
Next
End Sub
Sub UpdateSelectedParts()
Dim ws As Worksheet
Dim rng As Range, c As Range, cc As Range
Dim i As Integer

Set ws = Sheets("Selected Parts")
ws.Columns(1).ClearContents
ws.Range("A1") = "Selected Parts"
Set c = ws.Range("A2")
For Each ws In Worksheets
If ws.Name < "Selected Parts" Then
Set rng = ws.Columns(1).SpecialCells(2)
For Each cc In rng.Cells
If cc(1, 2) = "a" Then
i = i + 1
c(i) = cc
End If
Next
End If
Next
End Sub

greg:

just wanted to say, i didn't post the question this didn't help me, but it
is great that you took the time to write all that code to help somebody.

--


Gary


"Greg Wilson" wrote in message
...
It just occurred to me after the previous post that you can use
SpecialCells
instead of Dynamic Named ranges. This will greatly simplify the code. I
suggest you try this instead. Use a new workbook.

Regards,
Greg

Sub SetUp()
'Intended to only run this once in new workbook
Dim ws As Worksheet
Dim c As Range
Dim Code As String
Dim checkline As String
Dim i As Integer, ii As Integer
Dim x As Integer, Ln As Long

i = 0: x = 0
checkline = "Worksheet_SelectionChange"
Sheets(1).Name = "Selected Parts"
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "Selected Parts" Then
i = i + 1
ws.Name = "List " & i
ws.Cells.RowHeight = 12.75
ws.Columns(1).Locked = False
With ws.Columns(2)
.Locked = True
.ColumnWidth = 2.25
.Font.Name = "Marlett"
.Font.Bold = False
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
For ii = 1 To 25
x = x + 1
ws.Cells(ii, 1) = "Part " & x
Next
Code = "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" & _
vbCr & "Dim rng As Range" & _
vbCr & "If Target.Count 1 Then Exit Sub" & _
vbCr & "Set rng = me.Columns(1).SpecialCells(2).Offset(0,1)" & _
vbCr & "If Not Intersect(Target, rng) Is Nothing Then" & _
vbCr & "If Target = """" Then" & _
vbCr & "Target = ""a""" & _
vbCr & " Else" & _
vbCr & "Target = """"" & _
vbCr & "End If" & _
vbCr & "End If" & _
vbCr & "End Sub"
With ThisWorkbook.VBProject.VBComponents(ws.CodeName).C odeModule
Ln = .CountOfLines
If Not .Find(checkline, 1, 1, Ln, 1) Then .InsertLines Ln + 1, Code
End With
'ws.Protect UserInterfaceOnly:=True
End If
Next
End Sub
Sub UpdateSelectedParts()
Dim ws As Worksheet
Dim rng As Range, c As Range, cc As Range
Dim i As Integer

Set ws = Sheets("Selected Parts")
ws.Columns(1).ClearContents
ws.Range("A1") = "Selected Parts"
Set c = ws.Range("A2")
For Each ws In Worksheets
If ws.Name < "Selected Parts" Then
Set rng = ws.Columns(1).SpecialCells(2)
For Each cc In rng.Cells
If cc(1, 2) = "a" Then
i = i + 1
c(i) = cc
End If
Next
End If
Next
End Sub

Greg,

Thanks for the code, but when I ran it, I got the following error at this
line:

With ThisWorkbook.VBProject.VBComponents(ws.CodeName).C odeModule

Runtime error 1004 - Application-defined or object-defined error.

What is going on?

Thanks,

Gary


"Greg Wilson" wrote in message
...
It just occurred to me after the previous post that you can use
SpecialCells
instead of Dynamic Named ranges. This will greatly simplify the code. I
suggest you try this instead. Use a new workbook.

Regards,
Greg

Sub SetUp()
'Intended to only run this once in new workbook
Dim ws As Worksheet
Dim c As Range
Dim Code As String
Dim checkline As String
Dim i As Integer, ii As Integer
Dim x As Integer, Ln As Long

i = 0: x = 0
checkline = "Worksheet_SelectionChange"
Sheets(1).Name = "Selected Parts"
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "Selected Parts" Then
i = i + 1
ws.Name = "List " & i
ws.Cells.RowHeight = 12.75
ws.Columns(1).Locked = False
With ws.Columns(2)
.Locked = True
.ColumnWidth = 2.25
.Font.Name = "Marlett"
.Font.Bold = False
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
For ii = 1 To 25
x = x + 1
ws.Cells(ii, 1) = "Part " & x
Next
Code = "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" & _
vbCr & "Dim rng As Range" & _
vbCr & "If Target.Count 1 Then Exit Sub" & _
vbCr & "Set rng = me.Columns(1).SpecialCells(2).Offset(0,1)" & _
vbCr & "If Not Intersect(Target, rng) Is Nothing Then" & _
vbCr & "If Target = """" Then" & _
vbCr & "Target = ""a""" & _
vbCr & " Else" & _
vbCr & "Target = """"" & _
vbCr & "End If" & _
vbCr & "End If" & _
vbCr & "End Sub"
With ThisWorkbook.VBProject.VBComponents(ws.CodeName).C odeModule
Ln = .CountOfLines
If Not .Find(checkline, 1, 1, Ln, 1) Then .InsertLines Ln + 1, Code
End With
'ws.Protect UserInterfaceOnly:=True
End If
Next
End Sub
Sub UpdateSelectedParts()
Dim ws As Worksheet
Dim rng As Range, c As Range, cc As Range
Dim i As Integer

Set ws = Sheets("Selected Parts")
ws.Columns(1).ClearContents
ws.Range("A1") = "Selected Parts"
Set c = ws.Range("A2")
For Each ws In Worksheets
If ws.Name < "Selected Parts" Then
Set rng = ws.Columns(1).SpecialCells(2)
For Each cc In rng.Cells
If cc(1, 2) = "a" Then
i = i + 1
c(i) = cc
End If
Next
End If
Next
End Sub

Gary,

The code runs on my system and has on all systems I've had previous.
However, I see that someone else had the same problem with that line. I did
mention it was risky because code that modifies code is virus-like. I've
heard that some anti-virus sofware will delete entire code modules containing
"InsertLines" and "DeleteLines". In short, I suspect it's to do with security
settings. However, don't worry about it. It's actually very simple to do it
manually.

It is assumed that the main sheet that receives the selected parts list is
named "Selected Parts". Change the code to suit. It is also assumed that the
parts lists are in column A of the other sheets and the check boxes need to
be adjacent in column B.

Paste the following code into the code modules of each Parts List sheet.
Exclude the Selected Parts sheet code module:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
If Target.Count 1 Then Exit Sub
Set rng = Me.Columns(1).SpecialCells(2).Offset(0, 1)
If Not Intersect(Target, rng) Is Nothing Then
If Target = "" Then Target = "a" Else Target = ""
End If
End Sub

Paste the following code into a standard code module and use it to update
the Selected Parts list:

Sub UpdateSelectedParts()
Dim ws As Worksheet
Dim rng As Range, c As Range, cc As Range
Dim i As Integer
Set ws = Sheets("Selected Parts")
ws.Columns(1).ClearContents
ws.Range("A1") = "Selected Parts"
Set c = ws.Range("A2")
For Each ws In Worksheets
If ws.Name < "Selected Parts" Then
Set rng = ws.Columns(1).SpecialCells(2)
For Each cc In rng.Cells
If cc(1, 2) = "a" Then
i = i + 1
c(i) = cc
End If
Next
End If
Next
End Sub

Change the font name of column B of each parts list worksheet to Marlett and
adjust the column width so that it equals the row height - i.e. make the
cells square. Format the horizontal and vertical alignment properties both to
"Center" (FormatCellsAlignment tab). Set the font size to 9 or 10 and don't
make it bold.

You should find that selecting a cell in column B of each parts list sheet
will cause it to toggle between a check mark and blank but only if there is
text in the adjacent cell in column A. This allows you to increase or
decrease the size of the parts lists without having to do any maintenance. A
petty annoyance is that you cannot click the same cell twice in succession
and get it to toggle. You must click another cell before clicking the same
cell again. If you have a heading in cell A1 it will also get copied to the
selected parts list if you make cell B1 a check mark. This can be remedied
but we'll keep it simple for now.

Regards,
Greg

Greg,
Praise to you! This is exactly what I was looking for, but i have a probelm.
When I run the UpdateSelectedParts module, I get a "runtime error '1001'
cells not found." It does work, but I don't want to get this error every
time. The debugger takes me to this line: Set rng =
ws.Columns(1).SpecialCells(2)
Thanks!

"Greg Wilson" wrote:

Gary,

The code runs on my system and has on all systems I've had previous.
However, I see that someone else had the same problem with that line. I did
mention it was risky because code that modifies code is virus-like. I've
heard that some anti-virus sofware will delete entire code modules containing
"InsertLines" and "DeleteLines". In short, I suspect it's to do with security
settings. However, don't worry about it. It's actually very simple to do it
manually.

It is assumed that the main sheet that receives the selected parts list is
named "Selected Parts". Change the code to suit. It is also assumed that the
parts lists are in column A of the other sheets and the check boxes need to
be adjacent in column B.

Paste the following code into the code modules of each Parts List sheet.
Exclude the Selected Parts sheet code module:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
If Target.Count 1 Then Exit Sub
Set rng = Me.Columns(1).SpecialCells(2).Offset(0, 1)
If Not Intersect(Target, rng) Is Nothing Then
If Target = "" Then Target = "a" Else Target = ""
End If
End Sub

Paste the following code into a standard code module and use it to update
the Selected Parts list:

Sub UpdateSelectedParts()
Dim ws As Worksheet
Dim rng As Range, c As Range, cc As Range
Dim i As Integer
Set ws = Sheets("Selected Parts")
ws.Columns(1).ClearContents
ws.Range("A1") = "Selected Parts"
Set c = ws.Range("A2")
For Each ws In Worksheets
If ws.Name < "Selected Parts" Then
Set rng = ws.Columns(1).SpecialCells(2)
For Each cc In rng.Cells
If cc(1, 2) = "a" Then
i = i + 1
c(i) = cc
End If
Next
End If
Next
End Sub

Change the font name of column B of each parts list worksheet to Marlett and
adjust the column width so that it equals the row height - i.e. make the
cells square. Format the horizontal and vertical alignment properties both to
"Center" (FormatCellsAlignment tab). Set the font size to 9 or 10 and don't
make it bold.

You should find that selecting a cell in column B of each parts list sheet
will cause it to toggle between a check mark and blank but only if there is
text in the adjacent cell in column A. This allows you to increase or
decrease the size of the parts lists without having to do any maintenance. A
petty annoyance is that you cannot click the same cell twice in succession
and get it to toggle. You must click another cell before clicking the same
cell again. If you have a heading in cell A1 it will also get copied to the
selected parts list if you make cell B1 a check mark. This can be remedied
but we'll keep it simple for now.

Regards,
Greg

The problem is that the code was simplified and neglected the possibility of
there being sheets other than "Selected Parts", "List 1", "List 2" etc. You
must have one or more sheets that don't have any constant values in column A
(i.e. these are probably either blank or only contain formulae). The line:
"Set rng = ws.Columns(1).SpecialCells(2)" tries to set the rng variable to
the cell range composed of all cells in column A containing constants. Since
none were found this line causes an error.

The suggested solution is to rig the code so that it only searches the parts
lists sheets ("List 1", "List 2" etc.). Suggested is that you substitute the
line:
If ws.Name < "Selected Parts" Then
With:
If ws.Name Like "List*" Then

This assumes that the sheet names containing the parts all begin with
"List". If not change to suit.

You can also suppress errors using the statement "On Error Resume Next". If
there is a possibility that the "List #" sheets might occasionally be blank
in column A then you can use error suppresion: "On Error Resume Next"
preceeding the above line.

Regards,
Greg


"Maggie" wrote:

Greg,
Praise to you! This is exactly what I was looking for, but i have a probelm.
When I run the UpdateSelectedParts module, I get a "runtime error '1001'
cells not found." It does work, but I don't want to get this error every
time. The debugger takes me to this line: Set rng =
ws.Columns(1).SpecialCells(2)
Thanks!

"Greg Wilson" wrote:

Gary,

The code runs on my system and has on all systems I've had previous.
However, I see that someone else had the same problem with that line. I did
mention it was risky because code that modifies code is virus-like. I've
heard that some anti-virus sofware will delete entire code modules containing
"InsertLines" and "DeleteLines". In short, I suspect it's to do with security
settings. However, don't worry about it. It's actually very simple to do it
manually.

It is assumed that the main sheet that receives the selected parts list is
named "Selected Parts". Change the code to suit. It is also assumed that the
parts lists are in column A of the other sheets and the check boxes need to
be adjacent in column B.

Paste the following code into the code modules of each Parts List sheet.
Exclude the Selected Parts sheet code module:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
If Target.Count 1 Then Exit Sub
Set rng = Me.Columns(1).SpecialCells(2).Offset(0, 1)
If Not Intersect(Target, rng) Is Nothing Then
If Target = "" Then Target = "a" Else Target = ""
End If
End Sub

Paste the following code into a standard code module and use it to update
the Selected Parts list:

Sub UpdateSelectedParts()
Dim ws As Worksheet
Dim rng As Range, c As Range, cc As Range
Dim i As Integer
Set ws = Sheets("Selected Parts")
ws.Columns(1).ClearContents
ws.Range("A1") = "Selected Parts"
Set c = ws.Range("A2")
For Each ws In Worksheets
If ws.Name < "Selected Parts" Then
Set rng = ws.Columns(1).SpecialCells(2)
For Each cc In rng.Cells
If cc(1, 2) = "a" Then
i = i + 1
c(i) = cc
End If
Next
End If
Next
End Sub

Change the font name of column B of each parts list worksheet to Marlett and
adjust the column width so that it equals the row height - i.e. make the
cells square. Format the horizontal and vertical alignment properties both to
"Center" (FormatCellsAlignment tab). Set the font size to 9 or 10 and don't
make it bold.

You should find that selecting a cell in column B of each parts list sheet
will cause it to toggle between a check mark and blank but only if there is
text in the adjacent cell in column A. This allows you to increase or
decrease the size of the parts lists without having to do any maintenance. A
petty annoyance is that you cannot click the same cell twice in succession
and get it to toggle. You must click another cell before clicking the same
cell again. If you have a heading in cell A1 it will also get copied to the
selected parts list if you make cell B1 a check mark. This can be remedied
but we'll keep it simple for now.

Regards,
Greg