Automatically fill cells in excel using VBA

Question

Good afternoon community,

I am trying to work with VBA in Excel in order to try to apply this knowledge in my master’s thesis, but I have some doubts.

I am trying to create a VBA function that fills cells according to a certain value. In the following image I have two tables, one with values in the vertices and the other all filled by the value 1. The left frame, represents a surveillance camera, which is in cell B1. In the right frame the coverage area of the same camera is supposed to appear. The camera area occupies 10 cells.

The code I have is this::

Sub Limpar()
Range("G5:J8") = ""
End Sub

Sub Executar()
If Cells(5, "B").Value = 1 Then Preencher
End Sub

Sub Preencher()
Dim contador As Integer
contador = 10
Do While contador > 0
Range("G5:J8") = 1
contador = contador - 1
Loop
End Sub

And its result is this:

As you can see, my role fills everything, and the goal was only to fill 10 cells. What I intended was something similar to what is in the next picture:

Does anyone know how to do in VBA to show in the right frame only the number of cells filled by the camera area? That in this case 10 filled cells should appear. I know my code fills the whole board, but that’s not what I was trying to do, I wanted to fill the grid by grid until I made the 10 squares corresponding to the camera area of cell B5.

If I can get to a camera, I can probably get to other cameras of different areas and put in different vertices.

Thanks to those who help me.

Answer 1

Try to define a range limit and from that subtract the values, something like that:

Sub preencherCameras()
Dim Limite, Linha, Coluna As Integer
Limite = 4

    Linha = Application.ActiveCell.Row 'Linha Atual

    For y = 0 To Limite - 1 'Repetir até o Limite Alcance
        Coluna = Application.ActiveCell.Column 'Coluna Atual
        For x = 1 To Limite
            Cells(Linha + y, Coluna) = 1
            Coluna = Coluna + 1
        Next x
    Limite = Limite - 1 'Diminuir o limite
    Next y

End Sub

Answer 2

If it is something simple and fixed, just create 4 "Ifs" of these:

If Range("b5") = 1 Then
Range("g5,H5, I5,J5, G6, H6, I6, g7, h7, g8") = 1
End If