Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Discussion (Misc queries) > copy the command button and macro for multiple rows
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 17
Default copy the command button and macro for multiple rows
How can I copy the command button and macro for multiple rows ?

Private Sub CommandButton1_Click()
Dim Outlook As Object
Dim Appointment As Object
Dim Category As String
Dim Time As Variant

Const Item = 1

Set Outlook = CreateObject("Outlook.Application")
Set Appointment = Outlook.CreateItem(1)
Time = "08:30AM"

Appointment.Location = Range("a2") & ", " & Range("d2") & ", " & Range("e2")

Appointment.Subject = Range("i2")

Appointment.Start = DateAdd("d", 350, Range("b2")) & " " & Time

Appointment.Body = Range("a2") & ", " & Range("b2") & ", " & Range("c2") &
", " & Range("d2") & ", " & Range("e2")



Appointment.ReminderPlaySound = True
Appointment.Display

'Outlook.quit
'Set Outlook = Nothing
End Sub
--
problem
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 9,101
Default copy the command button and macro for multiple rows
Not sure what you want. I think this will do. It assumes you have the cells
you want in the appointment selected. I can can the code to use an inputbox
to select the cells.

Private Sub CommandButton1_Click()
Dim Outlook As Object
Dim Appointment As Object
Dim Category As String
Dim Time As Variant

Const Item = 1

Set Outlook = CreateObject("Outlook.Application")
Time = "08:30AM"
With ActiveCell
For RowOffset = 0 To (Selection.Rows.Count - 1)
Set Appointment = Outlook.CreateItem(1)
Appointment.Location = .Range("a2").Offset(RowOffset, 0) & _
", " & .Range("d2").Offset(RowOffset, 0) & ", " & _
.Range("e2").Offset(RowOffset, 0)

Appointment.Subject = .Range("i2").Offset(RowOffset, 0)

Appointment.Start = _
DateAdd("d", 350, .Range("b2").Offset(RowOffset, 0)) & _
" " & Time

Appointment.Body = _
.Range("a2").Offset(RowOffset, 0) & ", " & _
.Range("b2").Offset(RowOffset, 0) & ", " & _
.Range("c2").Offset(RowOffset, 0) & ", " & _
.Range("d2").Offset(RowOffset, 0) & ", " & _
.Range("e2").Offset(RowOffset, 0)

Appointment.ReminderPlaySound = True
Appointment.Display
Next RowOffset
End With
'Outlook.quit
'Set Outlook = Nothing
End Sub




"bigproblem" wrote:

How can I copy the command button and macro for multiple rows ?

Private Sub CommandButton1_Click()
Dim Outlook As Object
Dim Appointment As Object
Dim Category As String
Dim Time As Variant

Const Item = 1

Set Outlook = CreateObject("Outlook.Application")
Set Appointment = Outlook.CreateItem(1)
Time = "08:30AM"

Appointment.Location = Range("a2") & ", " & Range("d2") & ", " & Range("e2")

Appointment.Subject = Range("i2")

Appointment.Start = DateAdd("d", 350, Range("b2")) & " " & Time

Appointment.Body = Range("a2") & ", " & Range("b2") & ", " & Range("c2") &
", " & Range("d2") & ", " & Range("e2")



Appointment.ReminderPlaySound = True
Appointment.Display

'Outlook.quit
'Set Outlook = Nothing
End Sub
--
problem
Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 17
Default copy the command button and macro for multiple rows

I was looking to have a command button included on each row and synced with
the data in that specific row BUT this is great.

Is there a way to prevent duplicate appointments from being made. For
example the data is entered on one day and appointments created then the day
after additional data is entered. If the command button is used it will
recreate appointments from the day before.

THANKS !!!

--
problem


"joel" wrote:

Not sure what you want. I think this will do. It assumes you have the cells
you want in the appointment selected. I can can the code to use an inputbox
to select the cells.

Private Sub CommandButton1_Click()
Dim Outlook As Object
Dim Appointment As Object
Dim Category As String
Dim Time As Variant

Const Item = 1

Set Outlook = CreateObject("Outlook.Application")
Time = "08:30AM"
With ActiveCell
For RowOffset = 0 To (Selection.Rows.Count - 1)
Set Appointment = Outlook.CreateItem(1)
Appointment.Location = .Range("a2").Offset(RowOffset, 0) & _
", " & .Range("d2").Offset(RowOffset, 0) & ", " & _
.Range("e2").Offset(RowOffset, 0)

Appointment.Subject = .Range("i2").Offset(RowOffset, 0)

Appointment.Start = _
DateAdd("d", 350, .Range("b2").Offset(RowOffset, 0)) & _
" " & Time

Appointment.Body = _
.Range("a2").Offset(RowOffset, 0) & ", " & _
.Range("b2").Offset(RowOffset, 0) & ", " & _
.Range("c2").Offset(RowOffset, 0) & ", " & _
.Range("d2").Offset(RowOffset, 0) & ", " & _
.Range("e2").Offset(RowOffset, 0)

Appointment.ReminderPlaySound = True
Appointment.Display
Next RowOffset
End With
'Outlook.quit
'Set Outlook = Nothing
End Sub




"bigproblem" wrote:

How can I copy the command button and macro for multiple rows ?

Private Sub CommandButton1_Click()
Dim Outlook As Object
Dim Appointment As Object
Dim Category As String
Dim Time As Variant

Const Item = 1

Set Outlook = CreateObject("Outlook.Application")
Set Appointment = Outlook.CreateItem(1)
Time = "08:30AM"

Appointment.Location = Range("a2") & ", " & Range("d2") & ", " & Range("e2")

Appointment.Subject = Range("i2")

Appointment.Start = DateAdd("d", 350, Range("b2")) & " " & Time

Appointment.Body = Range("a2") & ", " & Range("b2") & ", " & Range("c2") &
", " & Range("d2") & ", " & Range("e2")



Appointment.ReminderPlaySound = True
Appointment.Display

'Outlook.quit
'Set Outlook = Nothing
End Sub
--
problem
Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 9,101
Default copy the command button and macro for multiple rows
the code below puts an X in column F when an appointment is made. Then
checks for X before making a new appointment

Private Sub CommandButton1_Click()
Dim Outlook As Object
Dim Appointment As Object
Dim Category As String
Dim Time As Variant

Const Item = 1

Set Outlook = CreateObject("Outlook.Application")
Time = "08:30AM"
With ActiveCell
For RowOffset = 0 To (Selection.Rows.Count - 1)
If .Range("F2").Offset(RowOffset, 0) < "X" Then
.Range("F2").Offset(RowOffset, 0) = "X"
Set Appointment = Outlook.CreateItem(1)
Appointment.Location = .Range("a2").Offset(RowOffset, 0) & _
", " & .Range("d2").Offset(RowOffset, 0) & ", " & _
.Range("e2").Offset(RowOffset, 0)

Appointment.Subject = .Range("i2").Offset(RowOffset, 0)

Appointment.Start = _
DateAdd("d", 350, .Range("b2").Offset(RowOffset, 0)) & _
" " & Time

Appointment.Body = _
.Range("a2").Offset(RowOffset, 0) & ", " & _
.Range("b2").Offset(RowOffset, 0) & ", " & _
.Range("c2").Offset(RowOffset, 0) & ", " & _
.Range("d2").Offset(RowOffset, 0) & ", " & _
.Range("e2").Offset(RowOffset, 0)

Appointment.ReminderPlaySound = True
Appointment.Display
End If
Next RowOffset
End With
'Outlook.quit
'Set Outlook = Nothing
End Sub


"bigproblem" wrote:


I was looking to have a command button included on each row and synced with
the data in that specific row BUT this is great.

Is there a way to prevent duplicate appointments from being made. For
example the data is entered on one day and appointments created then the day
after additional data is entered. If the command button is used it will
recreate appointments from the day before.

THANKS !!!

--
problem


"joel" wrote:

Not sure what you want. I think this will do. It assumes you have the cells
you want in the appointment selected. I can can the code to use an inputbox
to select the cells.

Private Sub CommandButton1_Click()
Dim Outlook As Object
Dim Appointment As Object
Dim Category As String
Dim Time As Variant

Const Item = 1

Set Outlook = CreateObject("Outlook.Application")
Time = "08:30AM"
With ActiveCell
For RowOffset = 0 To (Selection.Rows.Count - 1)
Set Appointment = Outlook.CreateItem(1)
Appointment.Location = .Range("a2").Offset(RowOffset, 0) & _
", " & .Range("d2").Offset(RowOffset, 0) & ", " & _
.Range("e2").Offset(RowOffset, 0)

Appointment.Subject = .Range("i2").Offset(RowOffset, 0)

Appointment.Start = _
DateAdd("d", 350, .Range("b2").Offset(RowOffset, 0)) & _
" " & Time

Appointment.Body = _
.Range("a2").Offset(RowOffset, 0) & ", " & _
.Range("b2").Offset(RowOffset, 0) & ", " & _
.Range("c2").Offset(RowOffset, 0) & ", " & _
.Range("d2").Offset(RowOffset, 0) & ", " & _
.Range("e2").Offset(RowOffset, 0)

Appointment.ReminderPlaySound = True
Appointment.Display
Next RowOffset
End With
'Outlook.quit
'Set Outlook = Nothing
End Sub




"bigproblem" wrote:

How can I copy the command button and macro for multiple rows ?

Private Sub CommandButton1_Click()
Dim Outlook As Object
Dim Appointment As Object
Dim Category As String
Dim Time As Variant

Const Item = 1

Set Outlook = CreateObject("Outlook.Application")
Set Appointment = Outlook.CreateItem(1)
Time = "08:30AM"

Appointment.Location = Range("a2") & ", " & Range("d2") & ", " & Range("e2")

Appointment.Subject = Range("i2")

Appointment.Start = DateAdd("d", 350, Range("b2")) & " " & Time

Appointment.Body = Range("a2") & ", " & Range("b2") & ", " & Range("c2") &
", " & Range("d2") & ", " & Range("e2")



Appointment.ReminderPlaySound = True
Appointment.Display

'Outlook.quit
'Set Outlook = Nothing
End Sub
--
problem
Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 17
Default copy the command button and macro for multiple rows
Joel~
It now requires that i be in the row and column a to fill the data in the
appointment (the data in the appointment actually comes from the row
underneath). before it would also create appointments for all rows at one
time.
--
problem


"joel" wrote:

the code below puts an X in column F when an appointment is made. Then
checks for X before making a new appointment

Private Sub CommandButton1_Click()
Dim Outlook As Object
Dim Appointment As Object
Dim Category As String
Dim Time As Variant

Const Item = 1

Set Outlook = CreateObject("Outlook.Application")
Time = "08:30AM"
With ActiveCell
For RowOffset = 0 To (Selection.Rows.Count - 1)
If .Range("F2").Offset(RowOffset, 0) < "X" Then
.Range("F2").Offset(RowOffset, 0) = "X"
Set Appointment = Outlook.CreateItem(1)
Appointment.Location = .Range("a2").Offset(RowOffset, 0) & _
", " & .Range("d2").Offset(RowOffset, 0) & ", " & _
.Range("e2").Offset(RowOffset, 0)

Appointment.Subject = .Range("i2").Offset(RowOffset, 0)

Appointment.Start = _
DateAdd("d", 350, .Range("b2").Offset(RowOffset, 0)) & _
" " & Time

Appointment.Body = _
.Range("a2").Offset(RowOffset, 0) & ", " & _
.Range("b2").Offset(RowOffset, 0) & ", " & _
.Range("c2").Offset(RowOffset, 0) & ", " & _
.Range("d2").Offset(RowOffset, 0) & ", " & _
.Range("e2").Offset(RowOffset, 0)

Appointment.ReminderPlaySound = True
Appointment.Display
End If
Next RowOffset
End With
'Outlook.quit
'Set Outlook = Nothing
End Sub


"bigproblem" wrote:


I was looking to have a command button included on each row and synced with
the data in that specific row BUT this is great.

Is there a way to prevent duplicate appointments from being made. For
example the data is entered on one day and appointments created then the day
after additional data is entered. If the command button is used it will
recreate appointments from the day before.

THANKS !!!

--
problem


"joel" wrote:

Not sure what you want. I think this will do. It assumes you have the cells
you want in the appointment selected. I can can the code to use an inputbox
to select the cells.

Private Sub CommandButton1_Click()
Dim Outlook As Object
Dim Appointment As Object
Dim Category As String
Dim Time As Variant

Const Item = 1

Set Outlook = CreateObject("Outlook.Application")
Time = "08:30AM"
With ActiveCell
For RowOffset = 0 To (Selection.Rows.Count - 1)
Set Appointment = Outlook.CreateItem(1)
Appointment.Location = .Range("a2").Offset(RowOffset, 0) & _
", " & .Range("d2").Offset(RowOffset, 0) & ", " & _
.Range("e2").Offset(RowOffset, 0)

Appointment.Subject = .Range("i2").Offset(RowOffset, 0)

Appointment.Start = _
DateAdd("d", 350, .Range("b2").Offset(RowOffset, 0)) & _
" " & Time

Appointment.Body = _
.Range("a2").Offset(RowOffset, 0) & ", " & _
.Range("b2").Offset(RowOffset, 0) & ", " & _
.Range("c2").Offset(RowOffset, 0) & ", " & _
.Range("d2").Offset(RowOffset, 0) & ", " & _
.Range("e2").Offset(RowOffset, 0)

Appointment.ReminderPlaySound = True
Appointment.Display
Next RowOffset
End With
'Outlook.quit
'Set Outlook = Nothing
End Sub




"bigproblem" wrote:

How can I copy the command button and macro for multiple rows ?

Private Sub CommandButton1_Click()
Dim Outlook As Object
Dim Appointment As Object
Dim Category As String
Dim Time As Variant

Const Item = 1

Set Outlook = CreateObject("Outlook.Application")
Set Appointment = Outlook.CreateItem(1)
Time = "08:30AM"

Appointment.Location = Range("a2") & ", " & Range("d2") & ", " & Range("e2")

Appointment.Subject = Range("i2")

Appointment.Start = DateAdd("d", 350, Range("b2")) & " " & Time

Appointment.Body = Range("a2") & ", " & Range("b2") & ", " & Range("c2") &
", " & Range("d2") & ", " & Range("e2")



Appointment.ReminderPlaySound = True
Appointment.Display

'Outlook.quit
'Set Outlook = Nothing
End Sub
--
problem
Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 9,101
Default copy the command button and macro for multiple rows
Not sure what you mean by before. The orignal code only did one line. My
1st macro needed the rows selected to work. there were no changes with my
updates. If we are Putting an X in a column Then it won't be necessary to
select anything. here are the changes.

Private Sub CommandButton1_Click()
Dim Outlook As Object
Dim Appointment As Object
Dim Category As String
Dim Time As Variant

Const Item = 1

Set Outlook = CreateObject("Outlook.Application")
Time = "08:30AM"

With ActiveSheet
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 2 To LastRow
If .Range("F" & RowCount) < "X" Then
.Range("F" & RowCount) = "X"
Set Appointment = Outlook.CreateItem(1)
Appointment.Location = .Range("a" & RowCount) & _
", " & .Range("d" & RowCount) & ", " & _
.Range("e" & RowCount)

Appointment.Subject = .Range("i" & RowCount)

Appointment.Start = _
DateAdd("d", 350, .Range("b" & RowCount)) & _
" " & Time

Appointment.Body = _
.Range("a" & RowCount) & ", " & _
.Range("b" & RowCount) & ", " & _
.Range("c" & RowCount) & ", " & _
.Range("d" & RowCount) & ", " & _
.Range("e" & RowCount)

Appointment.ReminderPlaySound = True
Appointment.Display
End If
Next RowCount
End With
'Outlook.quit
'Set Outlook = Nothing
End Sub





"bigproblem" wrote:

Joel~
It now requires that i be in the row and column a to fill the data in the
appointment (the data in the appointment actually comes from the row
underneath). before it would also create appointments for all rows at one
time.
--
problem


"joel" wrote:

the code below puts an X in column F when an appointment is made. Then
checks for X before making a new appointment

Private Sub CommandButton1_Click()
Dim Outlook As Object
Dim Appointment As Object
Dim Category As String
Dim Time As Variant

Const Item = 1

Set Outlook = CreateObject("Outlook.Application")
Time = "08:30AM"
With ActiveCell
For RowOffset = 0 To (Selection.Rows.Count - 1)
If .Range("F2").Offset(RowOffset, 0) < "X" Then
.Range("F2").Offset(RowOffset, 0) = "X"
Set Appointment = Outlook.CreateItem(1)
Appointment.Location = .Range("a2").Offset(RowOffset, 0) & _
", " & .Range("d2").Offset(RowOffset, 0) & ", " & _
.Range("e2").Offset(RowOffset, 0)

Appointment.Subject = .Range("i2").Offset(RowOffset, 0)

Appointment.Start = _
DateAdd("d", 350, .Range("b2").Offset(RowOffset, 0)) & _
" " & Time

Appointment.Body = _
.Range("a2").Offset(RowOffset, 0) & ", " & _
.Range("b2").Offset(RowOffset, 0) & ", " & _
.Range("c2").Offset(RowOffset, 0) & ", " & _
.Range("d2").Offset(RowOffset, 0) & ", " & _
.Range("e2").Offset(RowOffset, 0)

Appointment.ReminderPlaySound = True
Appointment.Display
End If
Next RowOffset
End With
'Outlook.quit
'Set Outlook = Nothing
End Sub


"bigproblem" wrote:


I was looking to have a command button included on each row and synced with
the data in that specific row BUT this is great.

Is there a way to prevent duplicate appointments from being made. For
example the data is entered on one day and appointments created then the day
after additional data is entered. If the command button is used it will
recreate appointments from the day before.

THANKS !!!

--
problem


"joel" wrote:

Not sure what you want. I think this will do. It assumes you have the cells
you want in the appointment selected. I can can the code to use an inputbox
to select the cells.

Private Sub CommandButton1_Click()
Dim Outlook As Object
Dim Appointment As Object
Dim Category As String
Dim Time As Variant

Const Item = 1

Set Outlook = CreateObject("Outlook.Application")
Time = "08:30AM"
With ActiveCell
For RowOffset = 0 To (Selection.Rows.Count - 1)
Set Appointment = Outlook.CreateItem(1)
Appointment.Location = .Range("a2").Offset(RowOffset, 0) & _
", " & .Range("d2").Offset(RowOffset, 0) & ", " & _
.Range("e2").Offset(RowOffset, 0)

Appointment.Subject = .Range("i2").Offset(RowOffset, 0)

Appointment.Start = _
DateAdd("d", 350, .Range("b2").Offset(RowOffset, 0)) & _
" " & Time

Appointment.Body = _
.Range("a2").Offset(RowOffset, 0) & ", " & _
.Range("b2").Offset(RowOffset, 0) & ", " & _
.Range("c2").Offset(RowOffset, 0) & ", " & _
.Range("d2").Offset(RowOffset, 0) & ", " & _
.Range("e2").Offset(RowOffset, 0)

Appointment.ReminderPlaySound = True
Appointment.Display
Next RowOffset
End With
'Outlook.quit
'Set Outlook = Nothing
End Sub




"bigproblem" wrote:

How can I copy the command button and macro for multiple rows ?

Private Sub CommandButton1_Click()
Dim Outlook As Object
Dim Appointment As Object
Dim Category As String
Dim Time As Variant

Const Item = 1

Set Outlook = CreateObject("Outlook.Application")
Set Appointment = Outlook.CreateItem(1)
Time = "08:30AM"

Appointment.Location = Range("a2") & ", " & Range("d2") & ", " & Range("e2")

Appointment.Subject = Range("i2")

Appointment.Start = DateAdd("d", 350, Range("b2")) & " " & Time

Appointment.Body = Range("a2") & ", " & Range("b2") & ", " & Range("c2") &
", " & Range("d2") & ", " & Range("e2")



Appointment.ReminderPlaySound = True
Appointment.Display

'Outlook.quit
'Set Outlook = Nothing
End Sub
--
problem
Reply With QuoteReply With Quote
  #7   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 17
Default copy the command button and macro for multiple rows

you're the man!

--
problem


"joel" wrote:

Not sure what you mean by before. The orignal code only did one line. My
1st macro needed the rows selected to work. there were no changes with my
updates. If we are Putting an X in a column Then it won't be necessary to
select anything. here are the changes.

Private Sub CommandButton1_Click()
Dim Outlook As Object
Dim Appointment As Object
Dim Category As String
Dim Time As Variant

Const Item = 1

Set Outlook = CreateObject("Outlook.Application")
Time = "08:30AM"

With ActiveSheet
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 2 To LastRow
If .Range("F" & RowCount) < "X" Then
.Range("F" & RowCount) = "X"
Set Appointment = Outlook.CreateItem(1)
Appointment.Location = .Range("a" & RowCount) & _
", " & .Range("d" & RowCount) & ", " & _
.Range("e" & RowCount)

Appointment.Subject = .Range("i" & RowCount)

Appointment.Start = _
DateAdd("d", 350, .Range("b" & RowCount)) & _
" " & Time

Appointment.Body = _
.Range("a" & RowCount) & ", " & _
.Range("b" & RowCount) & ", " & _
.Range("c" & RowCount) & ", " & _
.Range("d" & RowCount) & ", " & _
.Range("e" & RowCount)

Appointment.ReminderPlaySound = True
Appointment.Display
End If
Next RowCount
End With
'Outlook.quit
'Set Outlook = Nothing
End Sub





"bigproblem" wrote:

Joel~
It now requires that i be in the row and column a to fill the data in the
appointment (the data in the appointment actually comes from the row
underneath). before it would also create appointments for all rows at one
time.
--
problem


"joel" wrote:

the code below puts an X in column F when an appointment is made. Then
checks for X before making a new appointment

Private Sub CommandButton1_Click()
Dim Outlook As Object
Dim Appointment As Object
Dim Category As String
Dim Time As Variant

Const Item = 1

Set Outlook = CreateObject("Outlook.Application")
Time = "08:30AM"
With ActiveCell
For RowOffset = 0 To (Selection.Rows.Count - 1)
If .Range("F2").Offset(RowOffset, 0) < "X" Then
.Range("F2").Offset(RowOffset, 0) = "X"
Set Appointment = Outlook.CreateItem(1)
Appointment.Location = .Range("a2").Offset(RowOffset, 0) & _
", " & .Range("d2").Offset(RowOffset, 0) & ", " & _
.Range("e2").Offset(RowOffset, 0)

Appointment.Subject = .Range("i2").Offset(RowOffset, 0)

Appointment.Start = _
DateAdd("d", 350, .Range("b2").Offset(RowOffset, 0)) & _
" " & Time

Appointment.Body = _
.Range("a2").Offset(RowOffset, 0) & ", " & _
.Range("b2").Offset(RowOffset, 0) & ", " & _
.Range("c2").Offset(RowOffset, 0) & ", " & _
.Range("d2").Offset(RowOffset, 0) & ", " & _
.Range("e2").Offset(RowOffset, 0)

Appointment.ReminderPlaySound = True
Appointment.Display
End If
Next RowOffset
End With
'Outlook.quit
'Set Outlook = Nothing
End Sub


"bigproblem" wrote:


I was looking to have a command button included on each row and synced with
the data in that specific row BUT this is great.

Is there a way to prevent duplicate appointments from being made. For
example the data is entered on one day and appointments created then the day
after additional data is entered. If the command button is used it will
recreate appointments from the day before.

THANKS !!!

--
problem


"joel" wrote:

Not sure what you want. I think this will do. It assumes you have the cells
you want in the appointment selected. I can can the code to use an inputbox
to select the cells.

Private Sub CommandButton1_Click()
Dim Outlook As Object
Dim Appointment As Object
Dim Category As String
Dim Time As Variant

Const Item = 1

Set Outlook = CreateObject("Outlook.Application")
Time = "08:30AM"
With ActiveCell
For RowOffset = 0 To (Selection.Rows.Count - 1)
Set Appointment = Outlook.CreateItem(1)
Appointment.Location = .Range("a2").Offset(RowOffset, 0) & _
", " & .Range("d2").Offset(RowOffset, 0) & ", " & _
.Range("e2").Offset(RowOffset, 0)

Appointment.Subject = .Range("i2").Offset(RowOffset, 0)

Appointment.Start = _
DateAdd("d", 350, .Range("b2").Offset(RowOffset, 0)) & _
" " & Time

Appointment.Body = _
.Range("a2").Offset(RowOffset, 0) & ", " & _
.Range("b2").Offset(RowOffset, 0) & ", " & _
.Range("c2").Offset(RowOffset, 0) & ", " & _
.Range("d2").Offset(RowOffset, 0) & ", " & _
.Range("e2").Offset(RowOffset, 0)

Appointment.ReminderPlaySound = True
Appointment.Display
Next RowOffset
End With
'Outlook.quit
'Set Outlook = Nothing
End Sub




"bigproblem" wrote:

How can I copy the command button and macro for multiple rows ?

Private Sub CommandButton1_Click()
Dim Outlook As Object
Dim Appointment As Object
Dim Category As String
Dim Time As Variant

Const Item = 1

Set Outlook = CreateObject("Outlook.Application")
Set Appointment = Outlook.CreateItem(1)
Time = "08:30AM"

Appointment.Location = Range("a2") & ", " & Range("d2") & ", " & Range("e2")

Appointment.Subject = Range("i2")

Appointment.Start = DateAdd("d", 350, Range("b2")) & " " & Time

Appointment.Body = Range("a2") & ", " & Range("b2") & ", " & Range("c2") &
", " & Range("d2") & ", " & Range("e2")



Appointment.ReminderPlaySound = True
Appointment.Display

'Outlook.quit
'Set Outlook = Nothing
End Sub
--
problem
Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Run a macro using a command button Tdahlman Excel Discussion (Misc queries) 9 March 5th 08 07:59 PM
Command Button to run a Macro Mark Allen Excel Worksheet Functions 2 June 4th 07 04:24 PM
Run Macro from Command Button [email protected] Excel Discussion (Misc queries) 1 April 23rd 07 04:36 PM
macro to copy multiple rows to separate worksheets OrlaH Excel Worksheet Functions 2 June 8th 06 03:15 PM
Using Command Button to copy cells Pennington Excel Discussion (Misc queries) 1 April 29th 05 02:30 AM


All times are GMT +1. The time now is 05:46 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement