Help with basic macro tools

arehman1289

New Member
Joined
Dec 10, 2020
Messages
22
Office Version
  1. 365
Platform
  1. Windows
Hello,

I have a worksheet in which a user inputs a number 'x' and depending on it lines 16-27 are copied 'x' times in the rows after. I would please ask for help in three issues:

1. I have three worksheets of this sort, and would require the same number 'x' to be copied in each worksheet after the users input and eventually duplicate lines. However at the moment I am having the user enter the number 'x' three different times in each worksheet. Is it possible for the user to just enter it once in the first worksheet and it gets updated automatically in the next two sheets ?

2. As an example, if the user enters 'x' as 3 i would like lines 16-27 copied 3 times. However, if in the next run he enters 2, i would like the third copied set to be deleted. How would I do that ?

3. Once again if the user enters 'x' as 3 i would like to save a specific cell value to be compared with the same cell value in next run in case he enters 'x' as 2. Is there anyway to do the comparison ?

Attached is the code for workheet 1:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Long
Dim nr As Long
Dim b As Long

' Exit if multiple cells updating simultaneously
If Target.CountLarge > 1 Then Exit Sub

' Only run if cell B1 updated
If Target.Address = Range("C2").Address Then
' Only run if numeric value entered
If IsNumeric(Target.Value) And (Target.Value > 0) Then
Application.ScreenUpdating = False
Application.EnableEvents = False
' Set default value of next row
nr = 28
' Loop through number of times to copy
For i = 1 To (Int(Target.Value) - 1)
' Copy values from A2:B5 to next range
Range("A16:D27").Copy Cells(nr, "A")
For b = 0 To 11
Cells((nr + b), "A").Interior.ColorIndex = nr
Cells((nr + b), "B").Interior.ColorIndex = nr
Cells((nr + b), "C").Interior.ColorIndex = nr
Cells((nr + b), "D").Interior.ColorIndex = nr
Next b
' Increment next start by 4 rows
nr = nr + 12
Next i
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End If

End Sub

Please help !! Thank you so much in advance for the help.
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Have a try with this revised version of your macro. It still needs some fixing but it does what you asked for. You can now adapt it as you prefer.
Details:
1) the 3 sheets are called SheetA, SheetB, SheetC, change as needed;
2) SheetA is the master (and contains this macro) where user inputs a number 'x'; must be first in array;
3) when number "x" is lowered the rows made redundant are cleared;
4) Interior.ColorIndex over 55 makes macro to crash, needs to be limited.
VBA Code:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim i      As Long
    Dim nr     As Long
    Dim b      As Long
    Dim lr     As Long                            '<= added
    Dim nrc    As Long                            '<= added
    Dim myWsh  As Variant                         '<= added
    Dim sht    As Long                            '<= added

    ' Exit if multiple cells updating simultaneously
    If Target.CountLarge > 1 Then Exit Sub
    ' Only run if cell C2 updated
    If Target.Address = Range("C2").Address Then
        ' Only run if numeric value entered
        If IsNumeric(Target.Value) And (Target.Value > 0) Then 'here you can add test if C2 > 55
            myWsh = Array("SheetA", "SheetB", "SheetC") '<= added - the first sheet is master
            'loop through sheet array
            For sht = 0 To 2                      '<= added
                With Worksheets(myWsh(sht))       '<= added
                    Application.ScreenUpdating = False
                    Application.EnableEvents = False
                    ' Set default value of next row
                    nr = 28
                    nrc = 3                       '<= added
                    'clear range
                    lr = .Range("A" & Rows.Count).End(xlUp).Row '<= added - find last row
                    If lr < 28 Then lr = 28       '<= added
                    .Range("A28:A" & lr).EntireRow.Clear '<= added - clear redundant rows
                    ' Loop through number of times to copy
                    For i = 1 To (Int(Target.Value) - 1)
                        ' Copy values from A2:B5 to next range
                        Worksheets(myWsh(0)).Range("A16:D27").Copy .Cells(nr, "A") '<= changed
                        For b = 0 To 11
                            .Cells((nr + b), "A").Interior.ColorIndex = nrc '<= changed
                            .Cells((nr + b), "B").Interior.ColorIndex = nrc '<= changed
                            .Cells((nr + b), "C").Interior.ColorIndex = nrc '<= changed
                            .Cells((nr + b), "D").Interior.ColorIndex = nrc '<= changed
                        Next b
                        ' Increment next start by 12 rows
                        nr = nr + 12
                        nrc = nrc + 1             '<= added - must not exceed 55
                    Next i
                End With                          '<= added
            Next sht                              '<= added
            Application.EnableEvents = True
            Application.ScreenUpdating = True
        End If
    End If
 
End Sub
 
Last edited:
Upvote 0
Solution
Just one small question. Ive made the macro on the master worksheet as per your suggestion above and everything is working in order. However I would like the macro to run and be updated when any change is made in any cell of the master worksheet, at the moment it only runs when the cell C2 updated ?

Thank you much in advance
 
Upvote 0
when any change is made in any cell of the master worksheet
You said it ;), just get rid of the two lines of code that do the test on Range("C2").Address (If ... / and / End If). Once done very manuale change in the master will trigger the Event.
 
Upvote 0

Forum statistics

Threads
1,212,933
Messages
6,110,757
Members
448,295
Latest member
Uzair Tahir Khan

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top