none
I want to paste formulas in a range using VBA RRS feed

  • Question

  • I want to paste formulas in Z6:Z100

    =IF(COUNTIFS($B$6:$B6,$B6,$D$6:$D6,$D6,$E$6:$E6,$E6,$F$6:$F6,$F6,$G$6:$G6,$G6) >1, "Duplicate row", "")

    and tried like below,

    Private Sub CheckBox1_Click()

    If CheckBox1.Value = True Then
    Sheet15.range(Z6).Value ="=IF(COUNTIFS($B$6:$B6,$B6,$D$6:$D6,$D6,$E$6:$E6,$E6,$F$6:$F6,$F6,$G$6:$G6,$G6) >1, Duplicate row", ""& """&)"""

    Sheet15.range(Z7).Value= "=IF(COUNTIFS($B$6:$B7,$B7,$D$6:$D7,$D7,$E$6:$E7,$E7,$F$6:$F7,$F7,$G$6:$G7,$G7) >1, Duplicate row", ""& """&)"""

    Else
    Sheet15.range("z6").Value = "" 'UnCheck

    Sheet15.range("z7").Value = "" 'UnCheck

    End If
    EndSub

    Can any one help ?,

    using Command button also helpful for me.

    Thanks in advance.



    Saturday, June 23, 2018 2:02 PM

Answers

  • I deleted my previous reply because I have written the code to be generic to the worksheet that contains the control.

    I have included 2 examples of code. One for use with a Checkbox and another for a Command button.

    Controls need to be ActiveX controls and the code goes in the worksheet module for the worksheet that has the Checkbox or Command button.

    The UDF (User Defined Function) is required for whichever example you use. The reason for the UDF is that it finds the last used row for the columns B:G irrespective of whether all of the columns have data all the way to the bottom.

    Code modified Oct 10, 2018 to fix problem encountered by OP.

    Private Sub CheckBox1_Click()
        Dim wsData As Worksheet
        Dim wsFormulas As Worksheet
        Dim r As Long       'Last row of data
        Dim strWS As String
       
        Set wsData = Worksheets("Sheet1")       'Edit "Sheet1" to sheet name CONTAINING source data
        Set wsFormulas = Worksheets("Sheet2")   'Edit "Sheet2" to sheet name to which formulas are created
       
        strWS = wsData.Name & "!"               'Data worksheet name with exclamation mark separator for COUNTIF formula
       
        If CheckBox1.Value = True Then
            With wsData
                r = LastRowOrCol(True, .Columns("B:G"))    'Get the last used row in the source data
            End With
           
            With wsFormulas
                .Range(.Cells(6, "Z"), .Cells(.Rows.Count, "Z")).ClearContents    'Clear the contents of the formula column
               
                'Note: Space and Undersocre at end of line is a line break
                       'in an otherwise single line of code
                .Cells(6, "Z").Formula = "=IF(COUNTIFS(" & strWS & "$B$6:$B$" & r & _
                                        "," & strWS & "$B6," & strWS & "$D$6:$D$" & r & _
                                        "," & strWS & "$D6," & strWS & "$E$6:$E$" & r & _
                                        "," & strWS & "$E6," & strWS & "$F$6:$F$" & r & _
                                        "," & strWS & "$F6," & strWS & "$G$6:$G$" & r & _
                                        "," & strWS & "$G6) >1, ""Duplicate row"", """")"
               
                .Cells(6, "Z").Copy Destination:=.Range(.Cells(7, "Z"), .Cells(r, "Z"))
            End With
        Else
            With wsFormulas
                .Range(.Cells(6, "Z"), .Cells(.Rows.Count, "Z")).ClearContents  'Removes formulas
            End With
        End If
    End Sub

    Private Sub CommandButton1_Click()
        Dim wsData As Worksheet
        Dim wsFormulas As Worksheet
        Dim r As Long       'Last row of data
        Dim strWS As String
       
        Set wsData = Worksheets("Sheet1")       'Edit "Sheet1" to sheet name CONTAINING source data
       
       
        Set wsFormulas = Worksheets("Sheet2")   'Edit "Sheet2" to sheet name to which formulas are created
       
        strWS = wsData.Name & "!"               'Data worksheet name with exclamation mark separator for COUNTIF formula
       
        With CommandButton1
            If .Caption = "Identify Dublicates" Then
                With wsData
                    r = LastRowOrCol(True, .Columns("B:G"))    'Get the last used row in the source data
                End With
               
                With wsFormulas
                    .Range(.Cells(6, "Z"), .Cells(.Rows.Count, "Z")).ClearContents    'Clear the contents of the formula column
                    'Note: Space and Undersocre at end of line is a line break
                           'in an otherwise single line of code
                    .Cells(6, "Z").Formula = "=IF(COUNTIFS(" & strWS & "$B$6:$B$" & r & _
                                            "," & strWS & "$B6," & strWS & "$D$6:$D$" & r & _
                                            "," & strWS & "$D6," & strWS & "$E$6:$E$" & r & _
                                            "," & strWS & "$E6," & strWS & "$F$6:$F$" & r & _
                                            "," & strWS & "$F6," & strWS & "$G$6:$G$" & r & _
                                            "," & strWS & "$G6) >1, ""Duplicate row"", """")"
                   
                    .Cells(6, "Z").Copy Destination:=.Range(.Cells(7, "Z"), .Cells(r, "Z"))
                End With
                .Caption = "Remove Formulas"
            Else
                With wsFormulas
                    .Range(.Cells(6, "Z"), .Cells(.Rows.Count, "Z")).ClearContents  'Removes formulas
                End With
               .Caption = "Identify Dublicates"
            End If
        End With
    End Sub


    Function LastRowOrCol(bolRowOrCol As Boolean, Optional rng As Range) As Long
        'Finds the last used row or column in a worksheet
        'First parameter is True for Last Row or False for last Column
        'Third parameter is optional
        'Must be specified if not ActiveSheet
       
        Dim lngRowCol As Long
        Dim rngToFind As Range
       
        If rng Is Nothing Then
            Set rng = ActiveSheet.Cells
        End If
       
        If bolRowOrCol Then
            lngRowCol = xlByRows
        Else
            lngRowCol = xlByColumns
        End If
       
        With rng
            Set rngToFind = rng.Find(What:="*", _
                    LookIn:=xlFormulas, _
                    LookAt:=xlPart, _
                    SearchOrder:=lngRowCol, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False)
        End With
       
        If Not rngToFind Is Nothing Then
            If bolRowOrCol Then
                LastRowOrCol = rngToFind.Row
            Else
                LastRowOrCol = rngToFind.Column
            End If
        End If
       
    End Function


    Regards, OssieMac


    Monday, June 25, 2018 2:11 AM
  • Dim rngData was left over from earlier code testing on this project and I forgot to remove it after deciding not to use it.

    Change the problem line to the following. Removes the End(xlUp) because if only the header is there then xlUp goes to the header cell and then it gets cleared. Leaving out the End(xlUp) now clears from row 6 to the bottom of the worksheet but that should not cause a problem.

    With wsFormulas
                .Range(.Cells(6, "Z"), .Cells(.Rows.Count, "Z")).ClearContents    'Clear the contents of the formula column


    Regards, OssieMac

    Tuesday, October 9, 2018 10:04 PM

All replies

  • Please confirm if you are trying to identify the duplicate rows in the range Z6:G100 because I have assumed that is what you are attempting to do and if so, the formula you have is incorrect and I have changed it.

    Is the data being tested for duplicates on Sheet15? If not, the following code example needs to be changed to include the worksheet name where the test for duplicates is being done.

    Using the command button is basically the same as the first part of the If code. However, please confirm if you want to used the same command button to identify the duplicates with inserted formulas and then to remove the formulas. If this is required then we will need to change the caption on the command button. 

    Private Sub CheckBox1_Click()

        If CheckBox1.Value = True Then
            Range("Z6").Formula = "=IF(COUNTIFS($B$6:$B$100,$B6,$D$6:$D$100,$D6,$E$6:$E$100,$E6,$F$6:$F$100,$F6,$G$6:$G$100,$G6) >1, ""Duplicate row"", """")"
            Range("Z6").Copy Destination:=Range("Z7:Z100")
        Else
            Range("Z6:Z100").ClearContents    'Removes formulas if CheckBox is False.
        End If
    End Sub

    To use a Command button then create the command button and then use the following code. Don't worry about the initial caption on the command button when you create it because the first time you click it, the caption will be replaced and then it will alternate between "Identify Dublicates" and "Remove Formulas". so that each time you click it then it will perform the opposite function.

    Private Sub CommandButton1_Click()
        With CommandButton1
            If .Caption = "Identify Dublicates" Then
                Range("Z6").Formula = "=IF(COUNTIFS($B$6:$B$100,$B6,$D$6:$D$100,$D6,$E$6:$E$100,$E6,$F$6:$F$100,$F6,$G$6:$G$100,$G6) >1, ""Duplicate row"", """")"
                Range("Z6").Copy Destination:=Range("Z7:Z100")
                .Caption = "Remove Formulas"
            Else
               Range("Z6:Z100").ClearContents  'Removes formulas
               .Caption = "Identify Dublicates"
            End If
        End With
    End Sub


    Regards, OssieMac

    Sunday, June 24, 2018 2:31 AM
  • Thanks a lot it works, and one more thing the range Z6:Z100 exactly I don't want to paste formulas in all cells, it depends on the other column cells range count, for example I have A6:A20 only the cells contains data, so here I want only to paste formulas Z6:Z20 and if A6:A50 only the cells contains data, so here I want only to paste formulas Z6:Z50. And your observation is exactly true "Is the data being tested for duplicates on Sheet15? ", the required data is in sheet1 and it should be formulas pasted in sheet2.

    Thanks OssieMac

    Sunday, June 24, 2018 3:12 PM
  • I deleted my previous reply because I have written the code to be generic to the worksheet that contains the control.

    I have included 2 examples of code. One for use with a Checkbox and another for a Command button.

    Controls need to be ActiveX controls and the code goes in the worksheet module for the worksheet that has the Checkbox or Command button.

    The UDF (User Defined Function) is required for whichever example you use. The reason for the UDF is that it finds the last used row for the columns B:G irrespective of whether all of the columns have data all the way to the bottom.

    Code modified Oct 10, 2018 to fix problem encountered by OP.

    Private Sub CheckBox1_Click()
        Dim wsData As Worksheet
        Dim wsFormulas As Worksheet
        Dim r As Long       'Last row of data
        Dim strWS As String
       
        Set wsData = Worksheets("Sheet1")       'Edit "Sheet1" to sheet name CONTAINING source data
        Set wsFormulas = Worksheets("Sheet2")   'Edit "Sheet2" to sheet name to which formulas are created
       
        strWS = wsData.Name & "!"               'Data worksheet name with exclamation mark separator for COUNTIF formula
       
        If CheckBox1.Value = True Then
            With wsData
                r = LastRowOrCol(True, .Columns("B:G"))    'Get the last used row in the source data
            End With
           
            With wsFormulas
                .Range(.Cells(6, "Z"), .Cells(.Rows.Count, "Z")).ClearContents    'Clear the contents of the formula column
               
                'Note: Space and Undersocre at end of line is a line break
                       'in an otherwise single line of code
                .Cells(6, "Z").Formula = "=IF(COUNTIFS(" & strWS & "$B$6:$B$" & r & _
                                        "," & strWS & "$B6," & strWS & "$D$6:$D$" & r & _
                                        "," & strWS & "$D6," & strWS & "$E$6:$E$" & r & _
                                        "," & strWS & "$E6," & strWS & "$F$6:$F$" & r & _
                                        "," & strWS & "$F6," & strWS & "$G$6:$G$" & r & _
                                        "," & strWS & "$G6) >1, ""Duplicate row"", """")"
               
                .Cells(6, "Z").Copy Destination:=.Range(.Cells(7, "Z"), .Cells(r, "Z"))
            End With
        Else
            With wsFormulas
                .Range(.Cells(6, "Z"), .Cells(.Rows.Count, "Z")).ClearContents  'Removes formulas
            End With
        End If
    End Sub

    Private Sub CommandButton1_Click()
        Dim wsData As Worksheet
        Dim wsFormulas As Worksheet
        Dim r As Long       'Last row of data
        Dim strWS As String
       
        Set wsData = Worksheets("Sheet1")       'Edit "Sheet1" to sheet name CONTAINING source data
       
       
        Set wsFormulas = Worksheets("Sheet2")   'Edit "Sheet2" to sheet name to which formulas are created
       
        strWS = wsData.Name & "!"               'Data worksheet name with exclamation mark separator for COUNTIF formula
       
        With CommandButton1
            If .Caption = "Identify Dublicates" Then
                With wsData
                    r = LastRowOrCol(True, .Columns("B:G"))    'Get the last used row in the source data
                End With
               
                With wsFormulas
                    .Range(.Cells(6, "Z"), .Cells(.Rows.Count, "Z")).ClearContents    'Clear the contents of the formula column
                    'Note: Space and Undersocre at end of line is a line break
                           'in an otherwise single line of code
                    .Cells(6, "Z").Formula = "=IF(COUNTIFS(" & strWS & "$B$6:$B$" & r & _
                                            "," & strWS & "$B6," & strWS & "$D$6:$D$" & r & _
                                            "," & strWS & "$D6," & strWS & "$E$6:$E$" & r & _
                                            "," & strWS & "$E6," & strWS & "$F$6:$F$" & r & _
                                            "," & strWS & "$F6," & strWS & "$G$6:$G$" & r & _
                                            "," & strWS & "$G6) >1, ""Duplicate row"", """")"
                   
                    .Cells(6, "Z").Copy Destination:=.Range(.Cells(7, "Z"), .Cells(r, "Z"))
                End With
                .Caption = "Remove Formulas"
            Else
                With wsFormulas
                    .Range(.Cells(6, "Z"), .Cells(.Rows.Count, "Z")).ClearContents  'Removes formulas
                End With
               .Caption = "Identify Dublicates"
            End If
        End With
    End Sub


    Function LastRowOrCol(bolRowOrCol As Boolean, Optional rng As Range) As Long
        'Finds the last used row or column in a worksheet
        'First parameter is True for Last Row or False for last Column
        'Third parameter is optional
        'Must be specified if not ActiveSheet
       
        Dim lngRowCol As Long
        Dim rngToFind As Range
       
        If rng Is Nothing Then
            Set rng = ActiveSheet.Cells
        End If
       
        If bolRowOrCol Then
            lngRowCol = xlByRows
        Else
            lngRowCol = xlByColumns
        End If
       
        With rng
            Set rngToFind = rng.Find(What:="*", _
                    LookIn:=xlFormulas, _
                    LookAt:=xlPart, _
                    SearchOrder:=lngRowCol, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False)
        End With
       
        If Not rngToFind Is Nothing Then
            If bolRowOrCol Then
                LastRowOrCol = rngToFind.Row
            Else
                LastRowOrCol = rngToFind.Column
            End If
        End If
       
    End Function


    Regards, OssieMac


    Monday, June 25, 2018 2:11 AM
  • Everything is Good, But I didn't catch the Dim rngData.

    And also here is I am getting trouble 

    With wsFormulas
                    .Range(.Cells(6, "Z"), .Cells(.Rows.Count, "Z").End(xlUp)).ClearContents    'Clear the contents of the formula column

    In my destination sheet cell "Z5" have some data (Header) is also deleting and after re-Using the code.

    Regards, Harsha

    Tuesday, October 9, 2018 2:12 PM
  • Dim rngData was left over from earlier code testing on this project and I forgot to remove it after deciding not to use it.

    Change the problem line to the following. Removes the End(xlUp) because if only the header is there then xlUp goes to the header cell and then it gets cleared. Leaving out the End(xlUp) now clears from row 6 to the bottom of the worksheet but that should not cause a problem.

    With wsFormulas
                .Range(.Cells(6, "Z"), .Cells(.Rows.Count, "Z")).ClearContents    'Clear the contents of the formula column


    Regards, OssieMac

    Tuesday, October 9, 2018 10:04 PM