VBA Help

  • Thread starter Thread starter Scott Halper
  • Start date Start date
S

Scott Halper

I'm trying to create a macro to use for setting table assignments at
my wedding. What I'm trying to do is have a box on the left that
contains every single person's name who is invited (on a different
tab). Then I have colums that represent the different tables and when
I type someone's name in that column I want the person's name in the
large full list to disappear so that the large list only shows people
that are not assigned to a table yet.

Thanks in advance for the help.

Scott
 
ok, this works, with some minor glitches that i'm still working on.
'============================
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim ws2 As Worksheet
Dim wb As Workbook
Dim NameRange As Range
Dim LastRow As Long
Dim sName As String
Dim rFound As Range

Set wb = ActiveWorkbook
Set ws2 = wb.Worksheets("Sheet2")

Application.EnableEvents = False

LastRow = ws2.Range("a5000").End(xlUp).Row
Set NameRange = ws2.Range("a1:a" & LastRow)

sName = Target.Value

Set rFound = NameRange.Find(What:=sName, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
MatchCase:=False)

If rFound Is Nothing Then
MsgBox "Name " & sName & " not found in Range."
Else
rFound.ClearContents
End If

Application.EnableEvents = True

End Sub
'=====================
now for the glitches = 1. it misses the first name, in cell A1 of
sheet2. for now the work around is to start your name list in A2. :(
2. there's no error handling; give me another 15 minutes & i can fix
that.
3. i'm sure there's a much simpler way of doing it, which somebody
will show you before i can get this posted!
:)
susan
 
here it is with the error handling; maybe somebody else can tell us
both why it won't find starting at A1.
'=================
Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)

Dim ws2 As Worksheet
Dim wb As Workbook
Dim NameRange As Range
Dim LastRow As Long
Dim sName As String
Dim rFound As Range

Set wb = ActiveWorkbook
Set ws2 = wb.Worksheets("Sheet2")

On Error GoTo Drats

Application.EnableEvents = False

LastRow = ws2.Range("a5000").End(xlUp).Row
Set NameRange = ws2.Range("a1:a" & LastRow)

sName = Target.Value

Set rFound = NameRange.Find(What:=sName, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
MatchCase:=False)

If rFound Is Nothing Then
MsgBox "Name " & sName & " not found in Range."
Else
rFound.ClearContents
End If

Application.EnableEvents = True
Exit Sub

'====================
Drats:
Application.EnableEvents = True
MsgBox "ERROR"
Exit Sub
'=====================

End Sub
'===================
:)
susan
 
one teeny addition:

LastRow = ws2.Range("a5000").End(xlUp).Row
if lastrow = 1 then
msgbox "You are out of guests to seat!"
exit sub
end if
.....continue

susan
 
If you don't mind the name list being on the same worksheet as the table
assignments, I think you may like the following event code setup's
functionality. Put your name list in Column A. Next, decide on which columns
you will use for your table assignments and assign them to the FirstTable
and LastTable constant (the Const) statements at the top of the code. Now,
right click the tab at the bottom of the worksheet where your names are,
select View Code from the popup list that appears and copy paste all the
code below into the code window that opened up.

Once you have done that, go back to the worksheet, select a name (it will
highlight in a color to show you it is selected) and then double click a
cell in one of the table columns... the name will be moved from the list to
the cell you double clicked. If you make a mistake or change your mind about
an assignment, just double click a filled in cell in a table column and that
name will be moved back into the first empty slot in the name column... plus
it will remain the selected name so that you can simply double click into a
different table cell to place it there instead. Anyway, give this a try (on
a test sheet) to see if you like it or not.

'**************** START OF CODE ****************
Dim SelectedName As String
Dim SelectedAddress As String
Const FirstTable As Long = 2
Const LastTable As Long = 14

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
Dim UnusedCell As Range
If Target.Column >= FirstTable And Target.Column <= LastTable Then
Cancel = True
If Target.Value = "" Then
Target.Value = SelectedName
Range(SelectedAddress).Value = ""
Range(SelectedAddress).Interior.ColorIndex = 0
SelectedName = ""
Else
Set UnusedCell = Columns("A").Find("", After:=Cells(Rows.Count, "A"))
SelectedName = Target.Value
SelectedAddress = UnusedCell.Address
UnusedCell.Value = Target.Value
UnusedCell.Interior.ColorIndex = 4
UnusedCell.Select
Target.Value = ""
End If
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column = 1 Then
Intersect(ActiveSheet.UsedRange, Columns("A")).Interior.ColorIndex = 0
SelectedName = Target.Value
SelectedAddress = Target.Address
Target.Interior.ColorIndex = 4
End If
End Sub
'**************** END OF CODE ****************
 
If you don't mind the name list being on the same worksheet as the table
assignments, I think you may like the following event code setup's
functionality. Put your name list in Column A. Next, decide on which columns
you will use for your table assignments and assign them to the FirstTable
and LastTable constant (the Const) statements at the top of the code. Now,
right click the tab at the bottom of the worksheet where your names are,
select View Code from the popup list that appears and copy paste all the
code below into the code window that opened up.

Once you have done that, go back to the worksheet, select a name (it will
highlight in a color to show you it is selected) and then double click a
cell in one of the table columns... the name will be moved from the list to
the cell you double clicked. If you make a mistake or change your mind about
an assignment, just double click a filled in cell in a table column and that
name will be moved back into the first empty slot in the name column... plus
it will remain the selected name so that you can simply double click intoa
different table cell to place it there instead. Anyway, give this a try (on
a test sheet) to see if you like it or not.

'**************** START OF CODE ****************
Dim SelectedName As String
Dim SelectedAddress As String
Const FirstTable As Long = 2
Const LastTable As Long = 14

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
                                        Cancel As Boolean)
  Dim UnusedCell As Range
  If Target.Column >= FirstTable And Target.Column <= LastTable Then
    Cancel = True
    If Target.Value = "" Then
      Target.Value = SelectedName
      Range(SelectedAddress).Value = ""
      Range(SelectedAddress).Interior.ColorIndex = 0
      SelectedName = ""
    Else
      Set UnusedCell = Columns("A").Find("", After:=Cells(Rows.Count, "A"))
      SelectedName = Target.Value
      SelectedAddress = UnusedCell.Address
      UnusedCell.Value = Target.Value
      UnusedCell.Interior.ColorIndex = 4
      UnusedCell.Select
      Target.Value = ""
    End If
  End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Target.Column = 1 Then
    Intersect(ActiveSheet.UsedRange, Columns("A")).Interior.ColorIndex = 0
    SelectedName = Target.Value
    SelectedAddress = Target.Address
    Target.Interior.ColorIndex = 4
  End If
End Sub
'**************** END OF CODE ****************

--
Rick (MVP - Excel)








- Show quoted text -
Click to expand...

Rick,
That works, thanks for your help.

Scott
 
Back
Top