Add a column w/ formula to copy / paste macro

[wknight7]

Hi,
I have worked out code to copy paste rows from one sheet ot another, however I want to add a column to those rows with a formula to determine if they are repeats. I can't quite figure out how to work in that part. The following is the code I have that copy / pastes:

Sub CopyPasteSegmentation()
'
'
Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, srcWS2 As Worksheet, lRow As Long, lRow2 As Long, rg As Range, rg2 As Range
    Set srcWS = Sheets("segmentation current")
    Set desWS = Sheets("All YTD")
   
    lRow = srcWS.Range("A" & srcWS.Rows.Count).End(xlUp).Row
       
    Set rg = srcWS.Range("A2:P" & lRow)
   
    Set srcWS2 = Sheets("BI current")
       
    lRow2 = srcWS2.Range("A" & srcWS.Rows.Count).End(xlUp).Row
       
    Set rg2 = srcWS2.Range("A2:P" & lRow)
   
With desWS
    .Columns(1).NumberFormat = "m/dd/yyyy"
    .Columns(9).NumberFormat = "m/dd/yyyy"
    .Columns(8).NumberFormat = "m/dd/yyyy"
    .Columns(10).NumberFormat = "$#,##0.00"
    .Columns(11).NumberFormat = "$#,##0.00"
End With
   
    rg.copy
   
    desWS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
   
    rg2.copy
   
    desWS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
   
End Sub

Then the formula I need to add is as follows, which I hope will tell me if the added row is a duplicate of any row above it:

 "=IF(COUNTIFS(R2C3:R20000C3,RC3,R2C2:R20000C2,RC2,R2C1:R20000C1,""<""&RC1,R2C5:R20000C5,RC5),1,0)"

I'm copying / pasting rows from columns A-P in source worksheet to A-P in destination, and would like the above formula in column Q.

Any help would be appreciated. Thanks

 

[rlv01]

Did you intend this:

    Set rg2 = srcWS2.Range("A2:P" & lRow)

or did you mean to use this?

    Set rg2 = srcWS2.Range("A2:P" & lRow2)

 

[wknight7]

I took a lot of trial and error to get there, and that code was doing what I wanted it to do, however I suppose yes I did mean to use 1row2. I changed that and the code functions the same. It's well beyond my ability to know why.

 

[rlv01]

I took a lot of trial and error to get there, and that code was doing what I wanted it to do, however I suppose yes I did mean to use 1row2. I changed that and the code functions the same. It's well beyond my ability to know why.

It actually does not function the same. It might seem like it if the number rows of data in srcWS vs. srcWS2 are exactly the same. But if they are ever different, then the amount of data being copied will be different.

 

[rlv01]

Perhaps something like this.

Sub CopyPasteSegmentation()
    '
    '
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, srcWS2 As Worksheet, lRow As Long, lRow2 As Long, rg As Range, rg2 As Range
    Dim I As Long
    Dim rg3 As Range, FormulaString As String
    
    Set srcWS = Sheets("segmentation current")
    Set desWS = Sheets("All YTD")
    Set srcWS2 = Sheets("BI current")
    
    lRow = srcWS.Range("A" & srcWS.Rows.Count).End(xlUp).Row
    Set rg = srcWS.Range("A2:P" & lRow)
    
    lRow2 = srcWS2.Range("A" & srcWS.Rows.Count).End(xlUp).Row
    Set rg2 = srcWS2.Range("A2:P" & lRow2)
    
    With desWS
        For I = 1 To .Columns.Count
            Select Case I
                Case 1, 8, 9
                    .Columns(I).NumberFormat = "m/dd/yyyy"
                Case 10, 11
                    .Columns(I).NumberFormat = "$#,##0.00"
            End Select
        Next I
    End With
    
    rg.Copy
    
    desWS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    
    rg2.Copy
    
    desWS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    
    With desWS
        Set rg3 = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Offset(0, 16)
    End With
    
    FormulaString = "=IF(COUNTIFS(R2C3:R20000C3,RC3,R2C2:R20000C2,RC2,R2C1:R20000C1,""<""&RC1,R2C5:R20000C5,RC5),1,0)"
    rg3.FormulaR1C1 = FormulaString
    Application.ScreenUpdating = True
End Sub

 

[wknight7]

Perfect, thanks so much!