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,
M

 

[DanteAmor]

It's a bit strange how you compare the data, in one sheet the data starts at row 3 and in the other it starts at row 7. So you compare the data from row 3 with the data from row 7, then the data from row 4 with those of row 8 and so on.

Note:

You should not name the macro with the same name as a variable, you may get incorrect results.​

Sub Ownership()
... , Ownership()
...
ReDim Ownership(1 To UBound(rngB), 1 To 1)

More tips:

You shouldn't pile so many instructions in a row, it's not easy to read or understand.​

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

--------------

To keep the data, then you must load the data from the AN column into an array beforehand, I have named the variable as rngAN.
I made some adjustments to your code because the data doesn't start on the same row on both sheets.

Try the following:

Sub Ownership_Macro()
  Dim sh As Worksheet, sh2 As Worksheet
  Dim lr As Long, lr3 As Long
  Dim i&, rngD, rngB, rngC, rngN, rngAN
  Dim B As String, C As String, D As String, N As String
  
  Set sh = Sheets("Main")
  Set sh2 = Sheets("Audit_Plan")
  
  lr = sh.Range("A" & Rows.Count).End(xlUp).Row
  lr3 = sh2.Range("AN" & Rows.Count).End(xlUp).Row
  If lr3 - 4 < lr Then lr3 = lr + 4
  
  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" & lr3).Value
  rngAN = sh2.Range("AN7:AN" & lr3).Value
  
  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 ""
        rngAN(i, 1) = "Non-O&T"
      Case Not (D Like "*Non-O&T Business*") And D <> "" And N Like ""
        rngAN(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
          rngAN(i, 1) = "Non-O&T"
        Else
          rngAN(i, 1) = "O&T Area"
        End If
    End Select
  Next
  
  sh2.Range("AN7").Resize(UBound(rngAN), 1).Value = rngAN
End Sub

If you have problems, it would be very helpful if you put a sample data to test.

--------------
I hope to hear from you soon.
Respectfully
Dante Amor
--------------