Conditional Copy/Paste Macro

[GrahamVincent]

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')

Employee	Termination Date	Supervisor Name	Teamlead Name
Smith, Bob		Jones, Sue	Brown, Henry
Jones, Sue			Brown, Henry

<tbody>
</tbody>

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'

Employee	Termination Date	Supervisor Name	Teamlead Name
Smith, Bob		Jones,Sue	Brown, Henry
Smith, Bob		Jones,Sue	Brown, Henry
Smith, Bob		Jones,Sue	Brown, Henry
Smith, Bob		Jones,Sue	Brown, Henry
Smith, Bob		Jones,Sue	Brown, Henry
Jones, Sue			Brown, Henry

<tbody>
</tbody>

Code needed to provide;

Call Number	Employee	Termination Date	Supervisor Name	Teamlead Name
Call 1	Smith, Bob		Jones,Sue	Brown, Henry
Call 2	Smith, Bob		Jones,Sue	Brown, Henry
Call 3	Smith, Bob		Jones,Sue	Brown, Henry
Call 4	Smith, Bob		Jones,Sue	Brown, Henry
Call 5	Smith, Bob		Jones,Sue	Brown, Henry
Call 1	Jones, Sue			Brown, Henry

<tbody>
</tbody>

Current 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

 

[Fluff]

How about

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

 

[GrahamVincent]

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

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


Is there a better way than this?

 

[Fluff]

Try this

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.

 

[GrahamVincent]

You're an absolute star, much appreciate
I really need brush up on Ranges.

thanks again

 

[Fluff]

Glad to help & thanks for the feedback