Macro to fill cells with a number based on value of another cell

[Blokeman]

Hi,

I have cells B6:B20, E6:E20, H6:H20, K6:K20, N6:N20, Q6:Q20, T6:T20 and W6:W20, example if cell P2 have a value of 20 then start at B6 to E10 (20 cells) should fill a number 104, the worksheet is protected. Still learning to code.

Thanks

[aydeegee]

Hi Blokeman

if cell P2 have a value of 20 then start at B6 to E10 (20 cells) should fill a number 104

I am guessing the this means that B6 to E10 should be 104 if P2 = 20. What should the value be if P2 is anything else?

Regards
Alastair

[Blokeman]

Hi aydeegee, thanks for your reply. The value in P2 represent how many cells that will be filled with 104 so it could be from 1 to 120 cells (B6:B20, E6:E20, H6:H20, K6:K20, N6:N20, Q6:Q20, T6:T20 and W6:W20 = 120 cells). Hope this help.

[aydeegee]

OK. So you want P2 to count the number of times 104 appears in those cells ? Will it always be 104 or could it ever be another number?
Regards
Alastair

[Blokeman]

It always be 104.
Thanks

[aydeegee]

Hi Blokeman

I have attached 3 versions of what I understand you to want, with Version 1 being the best.

Do these do what you want?

Regards
Alastair

[Blokeman]

Hi aydeegee,

Thanks for your help and time, but I miss your question in post #4 when you said count the number of times, it's the other way around. Example, if P2 have a value of 20 then it will assign/fill the value 104 beginning with B6 to E10 (20 cells), the value that changes here is P2, it could be from 1 to 120 that's the total range of cells that I've given from my original post, it should always start at B6. Hope this help.

Thanks
Blokeman

[aydeegee]

Hi Blokeman

Do you mean as attached?

Regards
Alastair

[Blokeman]

Hi Alastair,

This is what I want. Thank you very much for your help and time. Have a nice day.

Regards
Blokeman

[aydeegee]

You're welcome

Alastair

[Blokeman]

The code below was made by Alastair and if possible if it will fill only empty cells.

Thanks

Sub Count104()

   Dim MyNo(120)
   Application.ScreenUpdating = False
   Count = Range("P2")
   If Count > 120 Then
   f = MsgBox("Box Qty. is " & Count & " which is greater than 120.  Exiting system.", vbOKOnly, "E r r o r")
   Exit Sub
   End If
   
   For c = 1 To Count
   MyNo(c) = 104
   Next c
   
   Cells(5, 2).Select
   
   j = 1
Again:
   For i = 1 To 15
   ActiveCell.Offset(i, 0) = MyNo(j)
   j = j + 1
   Next i
   
   
   If j <= 120 Then
   ActiveCell.Offset(0, 3).Select
   Else: Exit Sub
   End If
   
   GoTo Again
   Application.ScreenUpdating = True
End Sub

[aydeegee]

Hi Blokeman

So if the cell already has something in it, do not overwrite it.

What happens if P2 is 3 and B7 is (say) 555. Will your expected result be (a) 104,555,104 or (b) 104,555,104,104 ? Could you ever have the situation where P2 + number of cells already occupied will exceed 120?

Regards
Alastair

[Blokeman]

HI Alastair,

Thanks again for your reply. A user will going to enter a number between 1 to 103 and it will always be entered from cells B6 then B7, B8 so on an so forth. Example if P2 is 3 then lets say B6 is 103 then 103,104,104, you're right it will not overwrite the cell that has something in it. Hope this help.

Thanks again for your help.
Blokeman

[aydeegee]

Hi Blokeman

Macro updated so that anything other than <blank> or 104 will not be overwritten:

Sub Count104()
   
   Dim MyNo(120), MyCell As String
   
   Count = Range("P2")
   If Count > 120 Then
   f = MsgBox("P2 is " & Count & " which is greater than 120.  Exiting system.", vbOKOnly, "E r r o r")
   Exit Sub
   End If
   
   For c = 1 To Count
   MyNo(c) = 104
   Next c
   
   Cells(5, 2).Select
    j = 1
Again:
   For i = 1 To 15
   MyCell = ActiveCell.Offset(i, 0).Address
   If Range(MyCell) = 104 Or Range(MyCell) = "" Then Range(MyCell) = MyNo(j)
   j = j + 1
   Next i
   
   If j <= 120 Then
   ActiveCell.Offset(0, 3).Select
   Else: Exit Sub
   End If
   
   GoTo Again
      
End Sub

Let me know if this is OK

Regards
Alasair

[Blokeman]

Hi Alastair,

It's perfect. Once again thank you very much. Have a good weekend.

Regards
Blokeman

[Blokeman]

Hi,

I open this thread because I would like to protect the worksheet like "ActiveSheet.Unprotect Password:="xxx" and ActiveSheet.Protect Password:="xxx"", I tried these but I don't know where to insert the protect one and I don't know if this is the right code.

Thanks

[Blokeman]

bump......

[aydeegee]

Hi Blokeman

The following should do what you want

Sub Macro1()

Workbooks.Open Filename:="C:\Users\Alastair\Documents\Aworkbook.xlsx"
ActiveSheet.Unprotect "ABC123"
    
'(your macro)
    
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="ABC123"
 
End Sub

Regards
Alastair

[Blokeman]

Hi Alastair,

Thank you for your response, I've already done this but it doesn't protect the sheet.

Thanks
Blokeman

Private Sub CommandButton1_Click()

Dim MyNo(120), MyCell As String

   
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   
   ActiveSheet.Unprotect "xxx"

   Count = Range("P4")
   If Count > 120 Then
   f = MsgBox("Box Qty. is " & Count & " greater than 120.  Exiting system.", vbCritical + vbOKOnly, "E r r o r")
   Exit Sub
   End If
   
   For c = 1 To Count
   MyNo(c) = 104
   Cells(10, 2).Select
   
   Next c
   j = 1
   
Again:

   For i = 1 To 15
   MyCell = ActiveCell.Offset(i, 0).Address
   If Range(MyCell) = 104 Or Range(MyCell) = "" Then Range(MyCell) = MyNo(j)
   j = j + 1
   Next i
   
   
   If j <= 120 Then
   ActiveCell.Offset(0, 3).Select
   
   Else: Exit Sub
   
   End If

   GoTo Again

   ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="xxx"

   Application.DisplayAlerts = True
   Application.ScreenUpdating = True
      

End Sub

[aydeegee]

Hi Blokeman

Well it works for me!

I pasted your

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="xxx"

into a sheet and it works perfectly.

Protecting a sheet is a 2 stage operation. The cells have to be set to "Locked" (which is their default status) (right click Format > Protection > Locked) and then have to be "Protected". Protecting an unlocked cell will not have the results you require.

Hope this helps

Regards
Alastair

[Blokeman]

Hi Alastair

I run the macro (see post#19) and it only unprotect the sheet but did not protect. Cells set to locked and sheet is protected.

Thanks
Blokeman

[aydeegee]

Hi Blokeman

OK now I see what is happening. The macro is not getting to the correct line as it "Exit Sub"s before it gets there. Try this for the last few lines:

  Else: goto TheEnd      'Exit Sub (line amended)
   End If

   GoTo Again
TheEnd:  'new line entered
   ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="xxx"
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True
      
End Sub

Let me know if it works

Regards
Alastair

[Blokeman]

Hi Alastair

It works, thanks again for your help.

Regards
Blokeman

[Blokeman]

Hi Alastair

I've encountered problem, when there's already value on the cells and execute the macro again I get Run-time error '1004': Application-defined or object-defined error.

If Range(MyCell) = 104 Or Range(MyCell) = "" Then Range(MyCell) = MyNo(j)

Thanks
Blokeman

[aydeegee]

Hi Blokeman

I have run the updated macro on the last sheet that I sent you and it runs with no problem.

The only information that I can see on the internet relates to attempting tp paste to whole rows are whole columns, which you are not doing.

Perhaps if you would upload for file, I will be able to see the error for myself.

Regards#Alastair

[Blokeman]

Hi Alastair

I mean when you clear a cell and run the code again.

Regards
Blokeman

[aydeegee]

Hi Blokeman

I can see what is happening.

When the Private Sub worksheet_SelectionChange(ByVal Target As Range) is called, it turns on the password protection. Thus when you try to update the cell, the sheet is protected.

A simple solution is to comment out the line in the Private Sub worksheet_SelectionChange(ByVal Target As Range), but be aware that this may have an effect somewhere else.

Hope this helps

Regards
Alastair

[Blokeman]

Hi Alastair

I've decided to remove the Private Sub worksheet_SelectionChange(ByVal Target As Range). Thanks again for your help and time.

Regards
Blokeman