Microsoft Office Forums - View Single Post

mikec · 05-07-2013, 02:23 AM

Sorry; my partly developed code is as below. It doesn't work yet because I have to develop separate loop counters for the two tables before calling the InserLine sub. What I can say is that the ListRows.Add line does not clear the clipboard of previous copy entries. I will have to go off line now but will be happy to continue the conversation later unless you've had enough!

Code:

Sub Macro1() 
    Dim lnN As Integer 
     'Dim lcWasAt As String
    Sheets("Diary").Activate 
    Range("SummerCompTable").Select 
    For lnN = 1 To Selection.ListObject.ListRows.Count 
        Range("SummerCompTable").Range(Cells(lnN, 4), Cells(lnN, 4)).Select 
        Select Case ActiveCell 
        Case "Both" 
            Call InsertLine("POYCompTable", lnN) 
            Call InsertLine("ScratchCompTable", lnN) 
        Case "POY" 
            Call InsertLine("POYCompTable", lnN) 
        Case "Scratch" 
            Call InsertLine("ScratchCompTable", lnN) 
        Case Else 
            MsgBox "Data error in 'Where' column" 
            Exit Sub 
        End Select 
    Next lnN 
End Sub 
  
Sub InsertLine(lcDiaryName As String, lnLoopNo As Integer) 
    With Range(lcDiaryName) 
        .ListObject.ListRows.Add (lnLoopNo) 
        Range("SummerCompTable").Range(Cells(lnLoopNo, 1), Cells(lnLoopNo, 3)).Copy 
        .ListObject.ListRows(lnLoopNo).Range.PasteSpecial 
    End With 
End Sub