Update Range of Cells for cells that meet certain criteria

[MHamid]

Hello,

I made a small update to my code to only update cells that meet certain conditions. However, it's clearing all data in cell range AN regardless to update data. I want to keep existing data for cells that do not meet the criteria specified in my code. Is it where I have it clearing the contents prior to entering the value? Should I add another line of code where it will need to meet a criteria to update the value?

Sub Ownership()
Dim sh As Worksheet
Dim sh2 As Worksheet
Dim lr As Long
Dim lr2 As Long
Dim i&, rngD, rngB, rngC, rngN, B As String, C As String, D As String, N As String, Ownership()
Set sh = Sheets("Main")
Set sh2 = Sheets("Audit_Plan")
lr = sh.Range("A" & Rows.Count).End(xlUp).Row
lr2 = sh2.Range("J" & Rows.Count).End(xlUp).Row
rngD = sh.Range("Q3:Q" & lr).Value: rngB = sh.Range("A3:A" & lr).Value: rngC = sh.Range("B3:B" & lr).Value: rngN = sh2.Range("D7:D" & lr2).Value
ReDim Ownership(1 To UBound(rngB), 1 To 1)
For i = 1 To UBound(rngB)
D = rngD(i, 1): B = rngB(i, 1): C = rngC(i, 1): N = rngN(i, 1)
Select Case True
Case D Like "*Non-O&T Business*" And N Like ""
Ownership(i, 1) = "Non-O&T"
Case Not (D Like "*Non-O&T Business*") And D <> "" And N Like ""
Ownership(i, 1) = "O&T Area"
Case D = "" And N Like ""
If B Like "*Non-O&T Business*" Or B = "" Or C Like "*Non-O&T Business*" Or C = "" Then
Ownership(i, 1) = "Non-O&T"
            Else
Ownership(i, 1) = "O&T Area"
            End If
        End Select
    Next
With sh2.Range("AN7").Resize(UBound(rngB), 1)
    .ClearContents
.Value = Ownership
End With
End Sub

Thank you,
MHamid

 

[Fluff]

Duplicate to: Update Range of Cells for cells that meet certain criteria

In future, please do not post the same question multiple times. Per Forum Rules (#12), posts of a duplicate nature will be locked or deleted.