Draw circles in multiple cells based on values from another sheet

Question

Sheet1....................................Sheet2

I'm currently trying to make a Macro that draws a circle in (Sheet 1) based on the cell value in (Sheet 2).

It is suppose to look for whether it is Yes or No from (Sheet 2), and then circling either a Yes or No for each row based on the cell value in (Sheet 1)

The current results for me is that all the circles are drawn in only (1) cell in (Sheet 1), and then selects the next cell.

Removing For i = 0 To 4 and If functions results in drawing circles in all the cells of both ranges in (Sheet 1).

Sub DrawCricles()
Dim Arng As Range, drawRng As Range, infoRng As Range, YesRng As Range, NoRng As Range, 
Set drawRng = Application.Selection
Set infoRng= Worksheets("Sheet2").Range("A1:A5") 'All the values in this range is either Yes/No
Set YesRng = Worksheets("Sheet1").Range("A1,A2,A3,A4,A5") 'All the values in this range is Yes
Set NoRng = Worksheets("Sheet1").Range("C1,C2,C3,C4,C5") 'All the values in this range is No

For i = 0 To 4
    NoRng(i).Select
    If infoRng(i).Value = "NO" Then
        NoRng(i).Select
        For Each Arng In drawRng.Areas
            With Arng
            x = Arng.Height * 0.1
            y = Arng.Width * 0.1
                Application.Worksheets("Sheet1").Ovals.Add Top:=.Top - x, Left:=.Left - y, _
                Height:=.Height + 2 * x, Width:=.Width - 5 * y
                With Application.Worksheets("Sheet1").Ovals(Worksheets("Sheet1").Ovals.Count)
                    .Interior.ColorIndex = xlNone
                    .ShapeRange.Line.Weight = 1.25
                End With
            End With
        Next
    Else
        YesRng(i).Select 
        For Each Arng In drawRng.Areas
            With Arng
            x = Arng.Height * 0.1
            y = Arng.Width * 0.1
                Application.Worksheets("Sheet1").Ovals.Add Top:=.Top - x, Left:=.Left + y * 4, _
                Height:=.Height + 2 * x, Width:=.Width - 3 * y
                With Application.Worksheets("Sheet1").Ovals(Worksheets("Sheet1").Ovals.Count)
                    .Interior.ColorIndex = xlNone
                    .ShapeRange.Line.Weight = 1.25
                End With
            End With
        Next
    End If
Next

Answer 1

A solution. It adds a circle in the right cell in Sheet1 depending on YES/NO value in Sheet2. This is rough, you'll have to adapt it to 100% fit your needs.

Sheet1 Sheet2

Sub DrawCircle(ByRef pRange As Range, ByRef pSheet As Worksheet, _
    Optional ByVal pNo As Boolean)
    Dim oVal As Object
    If pNo Then         'NO
        With pRange.Cells(1, 1)
            pSheet.Shapes.AddShape msoShapeOval, .Left, .Top, .Width, .Height
        End With
        With pSheet.Shapes(pSheet.Shapes.Count)
            .Line.ForeColor.RGB = RGB(255, 0, 0)
            .Fill.Visible = msoFalse
        End With
    Else
        With pRange.Cells(1, 1)
            pSheet.Shapes.AddShape msoShapeOval, .Left, .Top, .Width, .Height
        End With
        With pSheet.Shapes(pSheet.Shapes.Count)
            .Line.ForeColor.RGB = RGB(0, 255, 0)
            .Fill.Visible = msoFalse
        End With
    End If
End Sub

Sub TestIt()
    Dim infoRng As Range, YesRng As Range, NoRng As Range
    Dim rCell As Range
    Dim i As Long
    Set infoRng = Worksheets("Sheet2").Range("A1:A5") 'All the values in this range is either Yes/No
    Set YesRng = Worksheets("Sheet1").Range("A1:A5") 'All the values in this range is Yes
    Set NoRng = Worksheets("Sheet1").Range("B1:B5") 'All the values in this range is No
    For i = 1 To infoRng.Rows.Count
        If infoRng.Cells(i, 1).Value = "NO" Then
            Set rCell = NoRng.Cells(i, 1)
            DrawCircle rCell, ThisWorkbook.Worksheets("Sheet1"), True
        Else
            Set rCell = YesRng.Cells(i, 1)
            DrawCircle rCell, ThisWorkbook.Worksheets("Sheet1"), False
        End If
    Next i
End Sub

Answer 2

Tested:

Sub DrawCircles()
    Dim c As Range, infoRng As Range, YesNoRng As Range, i As Long, yn

    Set infoRng = Worksheets("Sheet2").Range("A1:A5")
    Set YesNoRng = Worksheets("Sheet1").Range("A1:B5")  'both columns...
    yn = UCase(infoRng.Cells(i).Value)
    For i = 1 To infoRng.Cells.Count    'index from 1 not zero
        'corresponding Y/N cell - choose based on Y/N
        yn = UCase(infoRng.Cells(i).Value)
        With YesNoRng.Cells(i, IIf(yn = "NO", 2, 1))
            ' .Parent is the Worksheet
            ' Ovals.Add() returns the added shape, so you can use it directly here
            With .Parent.Ovals.Add(Top:=.Top + 3, Left:=.Left + 3, _
                            Height:=.Height - 6, Width:=.Width - 6)

                .Interior.ColorIndex = xlNone
                .ShapeRange.Line.Weight = 1.25
            
            End With
        End With
    Next i
End Sub