Hi all,

I've been racking my brains over the coals trying to figure this out.
Currently, the code, deletes duplicate values from col.A and also
U. I want the duplicated values for these two columns to be added
to these columns for the corresponding row data.

Here's the code it's quite lenghty.

Sub ActionNonCompleted(LookinPath)
  Dim OutPL As Worksheet, LookinPath2 As String, NoOfRows As Integer
  LookinPath2 = LookinPath & "\"
  Sheets("Non_Completed").Activate
  'remove existing list
  On Error Resume Next
  ActiveSheet.ListObjects("List1").Unlist
  On Error GoTo 0
  lastrow = Cells(Rows.Count, "D").End(xlUp).Row
'clean out any existing output data
  With Range("D9:G" & WorksheetFunction.Max(9, lastrow))
    .Hyperlinks.Delete
    .ClearContents
    .Interior.ColorIndex = xlNone
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlTop
    .WrapText = True
  End With
  Range("A9:C" & WorksheetFunction.Max(9, lastrow)).ClearContents
  With Range("H9:AD" & WorksheetFunction.Max(9, lastrow))
    .ClearContents ' clears contents from col H to AD on Non_Completed
    .Interior.ColorIndex = xlNone 'clears cell color for these columns
  End With
  Set OutPL = Sheets("Non_Completed")
  Sheets("Working_Non_Completed").Activate
  lastrow = Cells(Rows.Count, 1).End(xlUp).Row
  ---code cut to conserve space-----------    
    
  'copy data across to output sheet and action
    'Set findit = OutPL.Range("A:A").Find(what:=Cells(i, 1).Value)
    Set findit = OutPL.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    'If Not findit Is Nothing Then
      
      'OutPL.Cells(findit.Row, "L").Resize(1, 4).Value = Cells(i, 1).Offset(0, 1).Resize(1, 4).Value
      'put in the descriptions and the mod date
    OutPL.Cells(findit.Row, "A").Value = Cells(I, "A").Value
     OutPL.Cells(findit.Row, "D").Resize(1, 4).Value = Cells(I, 1).Offset(0, 1).Resize(1, 4).Value
    OutPL.Cells(findit.Row, "B").Resize(1, 2).Value = Cells(I, "J").Resize(1, 2).Value
------------code cut to conserve space------------
   ' OutPL.Cells(findit.Row, "Z").Resize(1, 23).Value = Cells(i, 1).Offset(0, 1).Resize(1, 10).Value
    'OutPL.Cells(findit.Row, "AA").Value = Cells(i, "Q").Value
    OutPL.Cells(findit.Row, "AD").Value = Cells(I, 6).Value
    'Do Until OutPL.Cells(findit.Row, "L") = ""
    '  Set findit = findit.Offset(1, 0)
    'Loop
      'put in the links and qty
    OutPL.Cells(findit.Row, "D").Resize(1, 4).Value = Cells(I, 1).Offset(0, 1).Resize(1, 4).Value
    Sheets("Non_Completed").Activate
    outrow = findit.Row
------------------------- cut code to conserve space----------------
    If UCase(Ltxtdisp) = "RELEASED FOR CONSTRUCTION" Then Ltxtdisp = "RELEASED"
     If UCase(Ltxtdisp) = "RELEASED FOR MATERIAL PROCUREMENT" Then Ltxtdisp = "PROCUREMENT"
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(outrow, "D"), Address:= _
      Cells(outrow, "D").Value, TextToDisplay:=Ltxtdisp
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(outrow, "E"), Address:= _
      Cells(outrow, "E").Value, TextToDisplay:=Mtxtdisp
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(outrow, "F"), Address:= _
      Cells(outrow, "F").Value, TextToDisplay:=Ntxtdisp
    Sheets("Working_Non_Completed").Activate
    'End If
  Next I
    
  OutPL.Activate
  'turn off the calculation to speed up action when inputting formulas
  Application.Calculation = xlCalculationManual
  lastrow = Cells(Rows.Count, 1).End(xlUp).Row
  For I = lastrow To 10 Step -1
    Application.StatusBar = "Inserting Non Completed formulas for: " & I & " to 9."
    If WorksheetFunction.CountIf(Range("A:A"), Cells(I + 1, 1).Value) > 1 Then
  Cells(i + 1, 1).ClearContents 
' this clears any duplicate values from          
' column A. If I comment out this line it adds the value to each
'corresponding row.  But,I get a matching error for the                    
'Control Limits code below.

   Else
      NoOfRows = WorksheetFunction.CountIf(Sheets("working_non_completed").Range("A:A"), Cells(I, 1).Value)
      Cells(I, "H").formula = "=SUMPRODUCT((D" & I & ":D" & I + NoOfRows - 1 & "=""PRELIMINARY"")*(G" & I & ":G" & I + NoOfRows - 1 & "))"
      Cells(I, "I").formula = "=SUMPRODUCT((D" & I & ":D" & I + NoOfRows - 1 
-code cut to conserve space------------
STOCK (Incode & Yard Cts)
      Cells(I, "T").formula = "=S" & I & "-R" & I
      Cells(I, "U").formula = "=S" & I & "+V" & I & "-I" & I & "-K" & I & "-L" & I & "-M" & I
      formstr = "IF(SUM(I9,K9,L9,M9)>Control_Limits!Fxx,Control_Limits!F2,IF(SUM(I9,K9,L9,M9)<Control_Limits!Exx,Control_Limits!E2,IF(SUM(I9,K9,L9,M9)<Control_Limits!Dxx,Control_Limits!D2,IF(SUM(I9,K9,L9,M9)>Control_Limits!Cxx,Control_Limits!C2))))"
      formstr = WorksheetFunction.Substitute(formstr, 9, I)
      On Error Resume Next
      clpl = WorksheetFunction.Match(Cells(I, 1).Value, Sheets("Control_Limits").Range("A:A"), 0)
      On Error GoTo 0
      If IsEmpty(clpl) Then
        formstr = """ITEM NOT FOUND IN CONTROL_LIMITS"""
      Else
        formstr = WorksheetFunction.Substitute(formstr, "xx", clpl)
      End If
      Cells(I, "U").formula = "=" & formstr
      Set findit = Sheets("Control_Limits").Range("2:2").Find(what:=Cells(I + 1, "U").Value)
      If Not findit Is Nothing Then Cells(I, "U").Interior.ColorIndex = findit.Interior.ColorIndex
     Cells(I, 1).Resize(3, 1).EntireRow.Insert
      
 End If
  Next I
  'put the formulas into to 9
  I = 9
  NoOfRows = WorksheetFunction.CountIf(Sheets("working_non_completed").Range("A:A"), Cells(I, 1).Value)
  Cells(I, "H").formula = "=SUMPRODUCT((D" & I & ":D" & I + NoOfRows - 1 & "=""PRELIMINARY"")*(G" & I & ":G" & I + NoOfRows - 1 & "))"
  Cells(I, "I").formula = "=SUMPRODUCT((D" & I & ":D" & I + NoOfRows - 1 & "=""PENDING"")*(G" & I & ":G" & I + NoOfRows - 1 & "))"
  Cells(I, "J").formula = "=SUMPRODUCT((D" & I & ":D" & I + NoOfRows - 1 & "=""HOLD"")*(G" & I & ":G" & I + NoOfRows - 1 & "))"
  Cells(I, "K").formula = "=SUMPRODUCT((D" & I & ":D" & I + NoOfRows - 1 & "=""INVOICED"")*(G" & I & ":G" & I + NoOfRows - 1 & "))"
  Cells(I, "L").formula = "=SUMPRODUCT((D" & I & ":D" & I + NoOfRows - 1 & "=""PROCUREMENT"")*(G" & I & ":G" & I + NoOfRows - 1 & "))"
  Cells(I, "M").formula = "=SUMPRODUCT((D" & I & ":D" & I + NoOfRows - 1 & "=""RELEASED"")*(G" & I & ":G" & I + NoOfRows - 1 & "))"
  Cells(I, "N").formula = "=SUMPRODUCT((D" & I & ":D" & I + NoOfRows - 1 & "=""ISSUED"")*(G" & I & ":G" & I + NoOfRows - 1 & "))"
  Cells(I, "O").formula = "=SUMPRODUCT((D" & I & ":D" & I + NoOfRows - 1 & "=""COMPLETED"")*(G" & I & ":G" & I + NoOfRows - 1 & "))"
  Cells(I, "P").formula = "=SUM(H" & I & ":O" & I & ")"
  Cells(I, "T").formula = "=S" & I & "-R" & I
  Cells(I, "U").formula = "=S" & I & "+V" & I & "-I" & I & "-K" & I & "-L" & I & "-M" & I
  formstr = "IF(SUM(I9,K9,L9,M9)>Control_Limits!Fxx,Control_Limits!F2,IF(SUM(I9,K9,L9,M9)<Control_Limits!Exx,Control_Limits!E2,IF(SUM(I9,K9,L9,M9)<Control_Limits!Dxx,Control_Limits!D2,IF(SUM(I9,K9,L9,M9)>Control_Limits!Cxx,Control_Limits!C2))))"
  formstr = WorksheetFunction.Substitute(formstr, 9, I)
  On Error Resume Next
  clpl = WorksheetFunction.Match(Cells(I, 1).Value, Sheets("Control_Limits").Range("A:A"), 0)
  On Error GoTo 0
  If IsEmpty(clpl) Then
    formstr = """ITEM NOT FOUND IN CONTROL_LIMITS"""
  Else
    formstr = WorksheetFunction.Substitute(formstr, "xx", clpl)
  End If
  Cells(I, "U").formula = "=" & formstr
  Set findit = Sheets("Control_Limits").Range("2:2").Find(what:=Cells(I, "U").Value) 'i+1  starting on 2nd row?
  If Not findit Is Nothing Then Cells(, "U").Interior.ColorIndex = findit.Interior.ColorIndex
     
'perform cell pattern formating
  lastrow = Cells(Rows.Count, "D").End(xlUp).Row
  For I = 9 To lastrow
    Application.StatusBar = "Formatting Non Completed Cell Color " & I & " of " & lastrow
    If Not IsEmpty(Cells(I, "D")) Then
      Select Case Cells(I, "D").Value
        Case "HOLD": icol = 3
        Case "COMPLETED": icol = 4
        Case "ISSUED": icol = 43
        Case "RELEASED": icol = 36
        Case "INVOICED": icol = 40
        Case "PENDING": icol = 45
        Case "PRELIMINARY": icol = 42
        Case " ": icol = 2
        Case Else: icol = 0
      End Select
      Cells(I, "D").Resize(1, 4).Interior.ColorIndex = icol
    End If
  Next I
  'turn the calculation to automatic
  Application.Calculation = xlCalculationAutomatic
  Application.StatusBar = False
    Range("F3") = Format(Now(), "dddd,mmmm d,yyyy hh:mm AM/PM")
End Sub
One part that I try changing is:

  Cells(i + 1, 1).ClearContents
this clears any duplicate values from column A. If I comment out this line it adds the value to each
corresponding row.
I've tried commenting out the preceeding section of code.
But,I get a matching error for with the imputted values/ or code
will error out completely when it tried to imput the formulas.


I hope someone can make sense of this.

thanks,

bdb