VBA Code for Copying a Formula

[ppiplastics]

I would like to prompt the macro to ask for a column number and then enter the following formula in the cell from row 2 onward until the last data in the column:
=IF(A2="","Unique",IF(COUNTIF($A$2:$A$1000,A2)>0,"Match","Unique")). I want to populate the entire column where the data ends with the formula. In the second step I want the formula output to change from formula to a value.
Thank you for your help.
Thanks
Neal

 

[Peter_SSs]

.. enter the following formula in the cell from row 2 onward until the last data in the column

I assume you mean down to the last data in column A, not the column entered by the user since the code is going to populate that column with data?

=IF(A2="","Unique",IF(COUNTIF($A$2:$A$1000,A2)>0,"Match","Unique"))

I believe your formula is flawed as the only rows this will ever poulate with "Unique" are rows where column A is blank. Where there is data in column A, the COUNTIF will always be at least 1.

Try the following in a copy of your workbook, noting that the code
a) Asks for a a column letter (not number)
b) Uses your formula but I think you probably need to change that red 0 to a 1

Sub PopulateColumn()
  Dim Col As String
  Dim lr As Long
  Dim CheckCell As Range
  
  Col = InputBox("Enter column label")
    On Error Resume Next
    Set CheckCell = Range(Col & Rows.Count)
    On Error GoTo 0
    If Not CheckCell Is Nothing Then
      lr = Range("A" & Rows.Count).End(xlUp).Row
      With Range(Col & "2:" & Col & lr)
        .Formula = "=IF(A2="""",""Unique"",IF(COUNTIF($A$2:$A$" & lr & ",A2)>0,""Match"",""Unique""))"
        .Value = .Value
      End With
    End If
End Sub

 

[ppiplastics]

Peter,
A big thank you and it worked like a charm! And yes my formula should have the greater than 1 value and not zero.
Thank you for your help.
Have a great day! Or evening!
Thanks
Neal

 

[ppiplastics]

By the way, is it possible to prompt for the column first that it looks for duplicate value? Currently, it is looking for those value in column A. I would rather have it prompt me to enter a column number which it must look for duplicate values in.

 

[Peter_SSs]

So you want a prompt for both the column to check for duplicates and the column in which to put the results?

 

[ppiplastics]

Yes' Peter that is what I would appreciate:
1. Prompt me for column to look for duplicate values
2.Prompt me for column where to put results.
Appreciate your help.
Thank you
Neal

 

[Peter_SSs]

Yes' Peter that is what I would appreciate:
1. Prompt me for column to look for duplicate values
2.Prompt me for column where to put results.

Try this version then

Sub PopulateColumn_v2()
  Dim UniqueCol As String, ResultCol As String
  Dim lr As Long
  Dim TestUniqueCol As Range, TestResultCol As Range
  Dim InvalidCols As String
  
  UniqueCol = InputBox("Enter column to check for Match/Unique")
  ResultCol = InputBox("Enter column for results")
  On Error Resume Next
  Set TestUniqueCol = Range(UniqueCol & Rows.Count)
  Set TestResultCol = Range(ResultCol & Rows.Count)
  On Error GoTo 0
  If Not TestUniqueCol Is Nothing And Not TestResultCol Is Nothing Then
    lr = Range(UniqueCol & Rows.Count).End(xlUp).Row
    With Range(ResultCol & "2:" & ResultCol & lr)
      .Formula = Replace("=IF(#2="""",""Unique"",IF(COUNTIF($#$2:$#$" & lr & ",#2)>1,""Match"",""Unique""))", "#", UniqueCol)
      .Value = .Value
    End With
  Else
    Select Case True
      Case TestUniqueCol Is Nothing And TestResultCol Is Nothing
        InvalidCols = "Match/uniques column (" & UniqueCol & ") and Result column (" & ResultCol & ")"
      Case TestUniqueCol Is Nothing
        InvalidCols = "Match/uniques column (" & UniqueCol & ")"
      Case Else
        InvalidCols = "Result column (" & ResultCol & ")"
    End Select
    MsgBox "You entered invalid column label(s) as follows:" & vbLf & InvalidCols
  End If
End Sub

 

[ppiplastics]

Peter,
Thank you!! that was perfect.
Thank you for your help.
Regards,
Neal

 

[Peter_SSs]

Peter,
Thank you!! that was perfect.
Thank you for your help.
Regards,
Neal

You are very welcome. Glad it worked for you.

 

[ppiplastics]

Peter,
Thank you again! It certainly was a perfect solution to something I had been trying to do but failed to accomplish on my own.
Best Regards,
Neal