Conditional Copy/Paste Macro

G

GrahamVincent

New Member
Joined
Mar 3, 2009
Messages
5
Hi all

I currently have some code that copies and pastes rows, a variable number of times dependant on data in Supervisor Name field, to a new sheet.
What I am looking for is a way of adding a cell prior to the pasted data, populated with 'Call 1, Call 2 etc. which references the number of times the row has been copied.

thanks in advance for any help.


Current code achieves the following

Source Data (Sheet 'A')
[TABLE="width: 492"]
<tbody>[TR]
[TD="class: xl66, width: 207, bgcolor: #BFD2E2"]Employee
[/TD]
[TD="class: xl66, width: 135, bgcolor: #BFD2E2"]Termination Date
[/TD]
[TD="class: xl66, width: 167, bgcolor: #BFD2E2"]Supervisor Name
[/TD]
[TD="class: xl66, width: 148, bgcolor: #BFD2E2"]Teamlead Name
[/TD]
[/TR]
[TR]
[TD="class: xl67, bgcolor: transparent"]Smith, Bob
[/TD]
[TD="class: xl68, bgcolor: transparent"][/TD]
[TD="class: xl67, bgcolor: transparent"]Jones, Sue
[/TD]
[TD="class: xl67, bgcolor: transparent"]Brown, Henry
[/TD]
[/TR]
[TR]
[TD="class: xl67, bgcolor: transparent"]Jones, Sue
[/TD]
[TD="class: xl68, bgcolor: transparent"][/TD]
[TD="class: xl67, bgcolor: transparent"][/TD]
[TD="class: xl67, bgcolor: transparent"]Brown, Henry
[/TD]
[/TR]
[TR]
[TD="class: xl67, bgcolor: transparent"][/TD]
[TD="class: xl68, bgcolor: transparent"][/TD]
[TD="class: xl67, bgcolor: transparent"][/TD]
[TD="class: xl67, bgcolor: transparent"][/TD]
[/TR]
</tbody>[/TABLE]

If there is an entry in Supervisor Name field, this Row is copied 5 times
If there is no entry in Supervisor Name field, this Row is copied 1 time
Which gives this result;

Sheet 'B'
[TABLE="width: 492"]
<tbody>[TR]
[TD="class: xl66, width: 207, bgcolor: #BFD2E2"]Employee
[/TD]
[TD="class: xl66, width: 135, bgcolor: #BFD2E2"]Termination Date
[/TD]
[TD="class: xl66, width: 167, bgcolor: #BFD2E2"]Supervisor Name
[/TD]
[TD="class: xl66, width: 148, bgcolor: #BFD2E2"]Teamlead Name
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Smith, Bob
[/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"]Jones,Sue
[/TD]
[TD="bgcolor: transparent"]Brown, Henry
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Smith, Bob
[/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"]Jones,Sue
[/TD]
[TD="bgcolor: transparent"]Brown, Henry
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Smith, Bob
[/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"]Jones,Sue
[/TD]
[TD="bgcolor: transparent"]Brown, Henry
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Smith, Bob
[/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"]Jones,Sue
[/TD]
[TD="bgcolor: transparent"]Brown, Henry
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Smith, Bob
[/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"]Jones,Sue
[/TD]
[TD="bgcolor: transparent"]Brown, Henry
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Jones, Sue
[/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"]Brown, Henry
[/TD]
[/TR]
</tbody>[/TABLE]



Code needed to provide;
[TABLE="width: 492"]
<tbody>[TR]
[TD="class: xl66, width: 207, bgcolor: #BFD2E2"]Call Number
[/TD]
[TD="class: xl66, width: 207, bgcolor: #BFD2E2"]Employee
[/TD]
[TD="class: xl66, width: 135, bgcolor: #BFD2E2"]Termination Date
[/TD]
[TD="class: xl66, width: 167, bgcolor: #BFD2E2"]Supervisor Name
[/TD]
[TD="class: xl66, width: 148, bgcolor: #BFD2E2"]Teamlead Name
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Call 1
[/TD]
[TD="bgcolor: transparent"]Smith, Bob
[/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"]Jones,Sue
[/TD]
[TD="bgcolor: transparent"]Brown, Henry
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Call 2
[/TD]
[TD="bgcolor: transparent"]Smith, Bob
[/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"]Jones,Sue
[/TD]
[TD="bgcolor: transparent"]Brown, Henry
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Call 3
[/TD]
[TD="bgcolor: transparent"]Smith, Bob
[/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"]Jones,Sue
[/TD]
[TD="bgcolor: transparent"]Brown, Henry
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Call 4
[/TD]
[TD="bgcolor: transparent"]Smith, Bob
[/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"]Jones,Sue
[/TD]
[TD="bgcolor: transparent"]Brown, Henry
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Call 5
[/TD]
[TD="bgcolor: transparent"]Smith, Bob
[/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"]Jones,Sue
[/TD]
[TD="bgcolor: transparent"]Brown, Henry
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Call 1
[/TD]
[TD="bgcolor: transparent"]Jones, Sue
[/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"]Brown, Henry
[/TD]
[/TR]
</tbody>[/TABLE]




Current Code

Code: 
Sub CallCalculation()
   ' Macro to copy and paste a variable number of rows dependant on T/L or Supervisor to a new sheet.
     
    Dim rngSinglecell As Range
    Dim rngSupervisorCells As Range
    Dim intCount As Integer
     
     ' This sets the range for the Supervisor column.
    With Worksheets("A")
        Set rngSupervisorCells = .Range("C2", .Range("C2:C1000")) '.End(xlDown))
    End With
    
    For Each rngSinglecell In rngSupervisorCells
         
         ' Checks if Supervisor cell contains a value
        If IsEmpty(rngSinglecell.Value) = False Then
              ' Copy this row 5 times
                For intCount = 1 To 5
                     ' Copy the columns A,B,C into the next empty row in sheet(B)
                    Sheets("B").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(1, 3).Value = rngSinglecell.Offset(0, -2).Resize(1, 3).Value
                     
                     
                Next
                
          ' Checks if Supervisor cell contains a value
        ElseIf IsEmpty(rngSinglecell.Value) = True Then
              ' Copy this row once
                For intCount = 1 To 1
                     ' Copy the columns A,B,C,D into the next empty row in sheet(B)
                    Sheets("B").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(1, 4).Value = rngSinglecell.Offset(0, -2).Resize(1, 4).Value
                     
                                                
                Next
            
            
        End If
               
        
    Next
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Sort by date Sort by votes
How about
Code: 
Sub CallCalculation()
   ' Macro to copy and paste a variable number of rows dependant on T/L or Supervisor to a new sheet.
     
    Dim rngSinglecell As Range
    Dim rngSupervisorCells As Range
    Dim intCount As Integer
     
     ' This sets the range for the Supervisor column.
    With Worksheets("A")
        Set rngSupervisorCells = .Range("C2", .Range("C" & Rows.Count).End(xlUp))
    End With
    
    For Each rngSinglecell In rngSupervisorCells
         
         ' Checks if Supervisor cell contains a value
        If IsEmpty(rngSinglecell.Value) = False Then
                     ' Copy the columns A,B,C into the next empty row in sheet(B)
                    With Sheets("B").Range("A" & Rows.Count).End(xlUp)
                        .Offset(1, 1).Resize(5, 4).Value = rngSinglecell.Offset(0, -2).Resize(1, 4).Value
                        .Offset(1).Value = "Call 1"
                        .Offset(1).AutoFill .Offset(1).Resize(5)
                     End With
                
          ' Checks if Supervisor cell contains a value
        ElseIf IsEmpty(rngSinglecell.Value) = True Then
              ' Copy this row once
                     ' Copy the columns A,B,C,D into the next empty row in sheet(B)
               With Sheets("B").Range("A" & Rows.Count).End(xlUp)
                   .Offset(1, 1).Resize(1, 4).Value = rngSinglecell.Offset(0, -2).Resize(1, 4).Value
                   .Offset(1).Value = "Call 1"
               End With
        End If
    Next
End Sub
 
Upvote 0
Thanks, that's got most of the way there.

It has the same problem with a previous version of my code that stops when the last value in column 'C' is found.
If there are values in column 'A' after this, these are ignored.

I 'fixed' this by having a static range

Code: 
[With Worksheets("A")
        Set rngSupervisorCells = .Range("C2", .Range("C2:C1000")) '.End(xlDown))
    End With
/CODE]


Is there a better way than this?
 
Upvote 0
Try this
Code: 
Set rngSupervisorCells = .Range("C2", .Range("A" & Rows.Count).End(xlUp).Offset(, 2))
This will look for the last used cell in col A, to determine when to stop.
 
Upvote 0
Glad to help & thanks for the feedback
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question Question
Find customer in column & link to his pdf
2
Replies
16
Views
605
NoSparks
N
S
  • Question Question
Can a macro help create a user hierarchy?
Replies
7
Views
688
Akuini
Akuini
GMC The Macro Man
  • Question Question
Copy n Paste Filtered Data
Replies
1
Views
165
GMC The Macro Man
GMC The Macro Man
B
  • Question Question
Error message when copying and renaming a worksheet
2
Replies
13
Views
297
smozgur
smozgur
O
  • Solved
VBA - Filter columns, cut/paste rows new sheet, pivot table
2
Replies
12
Views
295
Skyybot
Skyybot

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top