Macro VBA Excel - Conditioned copy of reference cell to a range of side cells

[LeonelAFM]

First, thanks for the help.

I made a test macro for the first time to see if it worked and it was OK. However, it references a single cell due to the test.

Now, I need to extend this macro to a range of cells, where each reference cell has a different condition (column "S"), which generates a filling of a certain number of cells depending on the condition of the referenced cell.

In the figure below, I show the worksheet which I intend to apply the macro. Reference cells are in red and the horizontal ranges of cells to be filled (copied) in are in purple.

The code is below:

1) Read the reference cell

2) Compare its values range

3) Copy the value in reference cell into the range of cells as determined by the "IF" conditional

Thanks a lot for your help!!

[#2 · Accepted solution]

@LeonelAFM 

Sub Copiar()
    Dim r As Long
    Dim n As Long
    Application.ScreenUpdating = False
    For r = 104 To 108
        n = Application.RoundUp(Range("S" & r).Value, 0)
        If n <= 0 Then
            n = 1
        ElseIf n > 6 Then
            n = 6
        End If
        Range("T" & r).Resize(1, n).Value = Range("S" & r).Value
    Next r
    Application.ScreenUpdating = True
End Sub

Remark: a line such as

If Range("S104") > 1 <= 2 Then

is not valid. It should be

If Range("S104") >1 And Range("S104") <= 2 Then

[#3]

Hi Hans!!!
It worked like a charm my friend.
Thank you very much for your prompt support!!

Since that was my first macro I still have some difficults on understanding some points.
For example: After I click "Refresh All" at "PivotChart Analyze" option, the macro does not work. So, I closed the code window and run it again and this time is return to working. Is that a normal condition? How could I get around the issue?

Thanks a lot!

[#4]

@LeonelAFM 

That's strange - I don't see how refreshing pivottables would interfere with the macro...

[#5]

@Hans Vogelaar 

Hi Hans, me again!

Excuse me but I had to ask:

Weekly, I will have to add new rows to the this worksheet as shown.

1) In this case, the macro would work as MS Excel adding this new row to it, automatically as a new range?

2) And on the contrary, deleting a row, what would happen?

3) If not automatic, could I insert a command to turn it automatically?

Thanks for your patience and help.

[#6]

@LeonelAFM 

Hi Leonel,

The code currently handles only roes 104 to 108 (fixed).

To make it more dynamic:

• Will the range always begin in row 104?
• Is the range to be processed the last used range on the sheet, or are there other non-empty rows below it?

[#7]

Hi Hans!
1) Will the range always begin in row 104?
> No, it will start in row 8.

2) Is the range to be processed the last used range on the sheet, or are there other non-empty rows below it?
> There are other non-empty rows below it. Due they have some fixed values instead to be calculated.

Thanks Hans!

[#8]

@LeonelAFM 

Thanks. That means we'll need another way to determine the last row to be processed. How can we do that?

[#9]

@Hans Vogelaar 

Hi Hans!
I think we could use the word "Educacional" as an index on collumn "D". So, every part of workbook being up to this first row found by the macro command will be the macro range.

See the attachment.

Thanks a lot for your support!

[#10]

@LeonelAFM 

Thanks. Try this version:

Sub Copiar()
    Dim r As Long
    Dim m As Long
    Dim n As Long
    Application.ScreenUpdating = False
    m = Range("D:D").Find(What:="Educacional", LookAt:=xlWhole).Row
    For r = 8 To m - 1
        n = Application.RoundUp(Range("S" & r).Value, 0)
        If n <= 0 Then
            n = 1
        ElseIf n > 6 Then
            n = 6
        End If
        Range("T" & r).Resize(1, n).Value = Range("S" & r).Value
    Next r
    Application.ScreenUpdating = True
End Sub

[#11]

Hi Hans,
Unfortunately, until now, I could not test it 'cause after my fourth shot on Covid-19 vaccine got a hard side effect and now recovering. As soon as I test it, will let you know.
Thanks for your support.

[#12]

@LeonelAFM 

Get well soon!

[#13]

@Hans Vogelaar 

Hi Hans!
I tested it and worked without issues copying all figures in the right numbers of positions.

However, I made a mistake copying the wrong figures.
Because It copies the months of work instead the working days remaining distributed along those months of work. I mean: I wanted to copy (working remaining days divided by full working month) and copying the result on number of cells relating to full working month. See the picture for a better understanding.

Thanks for your patience!

[#14]

@LeonelAFM 

Change line #14 of the code to

        Range("T" & r).Resize(1, n).Value = Range("R" & r).Value / n

[#15]

MAGNIFICENT, Hans!!!!!!!!!!!!!!!!

Macro is perfectly working!!!!
Could you indicate me a good book to learn VBA?

Thank you very much for your support!!!!!

[#16]

@LeonelAFM 

Book:

Excel VBA Programming for Dummies (don't be put off by the title, it is a seriously helpful book)

Website:

Excel VBA Tutorial 

[#17]

Thank you one more time my friend!!