copy multiple rows of numbers to new location on same sheet.

[dwrowe001]

Hi everyone,
I am in need of your expertise again. I don’t know how to do it, so here I am.
What I need help with is coming up with a VBA formula which will copy entire multiple rows of numbers from their existing locations up and down to a new location swhen I click the “Update” button.

Pls refer to the attachment for below explanations:
To begin with, I have a group of 5 numbers at the top of my worksheet in cells K2:O2. These are the ref numbers. these numbers change, and when they do, I click the update button I need the tables for each of those Ref numbers to be updated.

So, take the first ref number for example, which is the Number 1. when I click the update button I need the VBA code to go to the table for the number 1, which is the first table… you can see the number one in cell A4 and A21 which designate table 1.. each number has 2 sections, a top and bottom section. So, when I click the update button in cell B2, the entire number row B18:AF18 of the top section for number 1 will be copied (not moved) to the top section, to cells B4:AF4. The numbers which are already in B4:AF4 and B5:AF5 will each move down one row, freeing up Row B4:AF4.

The same process should happen for the numbers in row B19:AF19 of the bottom section of number 1, these numbers will be Copied down into the storage section, to row B21:AF21. The numbers which are already in B21:AF21 and B22:AF22 should move down one row.

the Same Process should happen for each of the 5 reference numbers at the top. the reference numbers could be any number between 1 and 60.

Note that the the numbers rows that are being copied should remain.. they are just being copied.

also note that over time, there could and will be up to 12 number rows in any of the storage sections, of any number. If there are, and there is a new row of numbers being copied to it, the 12th row at the bottom of the list can be deleted.
This process should happen for each of the 5 reference numbers at the top, no matter what they are.. the number range spans from 1 to 60.
I hope this makes sense.. I totally suck at VBA, Kinda ok with formulas but macros are way out of my capabilities. I am totally grateful for any help offered. Thank you,
Dave

[dwrowe001]

all,
I originally posted this question here:
https://chandoo.org/forum/threads/co...h-button.42891

just wanted let everyone know.

[大灰狼1976]

Hi dwrowe001!
Something like below:

Sub Updata_test()
Dim arrRef, arrTop, arrBtm, r&, rng As Range
arrRef = [k2:o2]
Application.ScreenUpdating = False
With Sheets("NumStats")
  For i = 1 To UBound(arrRef, 2)
    Set rng = .Columns(1).Find(arrRef(1, i), lookat:=xlWhole)
    If rng Is Nothing Then MsgBox arrRef(1, i) & " Not Found!": Exit Sub
    r = rng.Row
    .Cells(r + 1, 2).Resize(12, 31) = .Cells(r, 2).Resize(12, 31).Value
    .Cells(r, 2).Resize(, 31) = .Cells(r + 14, 2).Resize(, 31).Value
    .Cells(r + 18, 2).Resize(11, 31) = .Cells(r + 17, 2).Resize(11, 31).Value
    .Cells(r + 17, 2).Resize(, 31) = .Cells(r + 15, 2).Resize(, 31).Value
  Next i
End With
Application.ScreenUpdating = True
End Sub

--Okami

[SamT]

Sub SamT()
'http://www.vbaexpress.com/forum/showthread.php?66142-copy-multiple-rows-of-numbers-to-new-location-on-same-sheet

Dim ActiveSection As Range
Dim Cel As Range
Dim RefNum As Range

For Each RefNum In Range("K2:O2")
    Set Cel = Range("A:A").Find(RefNum)
      'I sure hope my counts are correct
    Set ActiveSection = Range(Cel.Offset(0, 1). Cel.Offset(33, 30))
    With ActiveSection
           'Move (Cut+Insert) the last row to the first row, thus moving all the rest down one
           'Then paste the new data over the moved data
        .Rows(12).Cut (.Rows(1))
        .Rows(14).Copy .Rows(1)
        .Rows(29).Cut (.Rows(18))
        .Rows(15).Copy .Rows(18)
    End With
Next RefNum
End Sub

[dwrowe001]

Okami,
This worked great, Thank you for your time and effort compiling this for me.

There is one thing, while not problem with the way your code works, it can cause me problems... as it is now, your code permits me to update the same
rows over and over... I need it to not do this.. for example:
if I click the update the button multiple times using the same 5 Reference numbers it will cause duplicate numbers to be copied/pasted over and over. I can't have that.
can you modify your code so that it prevents duplicate copied numbers?

Dave

[dwrowe001]

Hi SamT,
Thank you for your assistance.. I get this error when I try your code:
"Run-Time Error '438'
Object doesn't support this property or method"

this line is the one that comes up in debug:
Set ActiveSection = Range(Cel.Offset(0, 1). Cel.Offset(33, 30))

Dave



Dave

[大灰狼1976]

Hi Dave!I'd like to reconfirm this question，If one or more of the 5 reference numbers has been changed, Do you want to update all or only the changed reference numbers?

[SamT]

Set ActiveSection = Range(Cel.Offset(0, 1). Cel.Offset(33, 30))That red dot should be a comma.

don't click the submit button multiple times.

if I click the update the button multiple times using the same 5 Reference numbers it will cause duplicate numbers to be copied/pasted over and over. I can't have that.

How do the numbers the reference cells change? there is a possibility to prevent multiple copies therein.

[dwrowe001]

Duplicate post

[dwrowe001]

duplicate post... deleted.

[dwrowe001]

Hi Dave!I'd like to reconfirm this question，If one or more of the 5 reference numbers has been changed, Do you want to update all or only the changed reference numbers?

Hi,
all of the 5 Reference numbers in K2:O2 change at the same time, all 5 at once.. never individually. So all 5 ref numbers update at same time and only once. And once they change to a new set of 5 numbers, I click the Update button to update the tables for those 5 numbers, once and only once. There shouldn't be any duplicate occurrences caused by multiple clicks of the update button.

Thank you again for all your help!!!
Dave

[SamT]

How do the numbers the reference cells change? there is a possibility to prevent multiple copies therein.

[dwrowe001]

How do the numbers the reference cells change? there is a possibility to prevent multiple copies therein.

Hi SamT,
the Ref numbers are totally random and are updated daily (Lottery). I manually enter them. the Duplication would only be if I inadvertently click the update button more then once while the same reference numbers were being used.

I like your solution of not hitting the update button more then once to prevent dupes... while logical, I'm only human. lol.
Dave

[paulked]

In the Sheet27(NumStats) code module:

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("K2:O2")) Is Nothing Then Cells(1, 1) = "0"
End Sub

Then the first line of your Update sub:

    If Cells(1, 1) <> "0" Then Exit Sub

and at the end of your Update sub:

    Cells(1, 1) = "1"

[大灰狼1976]

I have several considerations:
1. Using teacher paulked's change event method
Shortcomings:
a. After entering the cell editing mode, Change event will be triggered no matter whether the content is modified or not.
b. When the value in cell is generated by formula or linkcell of other control, The change event will not be triggered.
2. Use common variables to record the value of K2:O2, Do not deal with the same situation as the previous time.
Shortcomings: Common variables are initialized after code error or debugging.
3. Use formula to judge

The third method takes up a cell that is not used（For example, A1), We have to type "False" in cell A1 first and don't worry about it later.

As follows:

Sub Updata_test()
Dim arrRef, arrTop, arrBtm, r&, rng As Range
If [a1] = True Then Exit Sub
[a1] = "=K2&""-""&L2&""-""&M2&""-""&N2&""-""&O2=""" & Join([k2:o2&""], "-") & """"
arrRef = [k2:o2]
Application.ScreenUpdating = False
With Sheets("NumStats")
  For i = 1 To UBound(arrRef, 2)
    Set rng = .Columns(1).Find(arrRef(1, i), lookat:=xlWhole)
    If rng Is Nothing Then MsgBox arrRef(1, i) & " Not Found!": Exit Sub
    r = rng.Row
    .Cells(r + 1, 2).Resize(12, 31) = .Cells(r, 2).Resize(12, 31).Value
    .Cells(r, 2).Resize(, 31) = .Cells(r + 14, 2).Resize(, 31).Value
    .Cells(r + 18, 2).Resize(11, 31) = .Cells(r + 17, 2).Resize(11, 31).Value
    .Cells(r + 17, 2).Resize(, 31) = .Cells(r + 15, 2).Resize(, 31).Value
  Next i
End With
Application.ScreenUpdating = True
End Sub

[paulked]

Totally agree with Sheet_Change events, but this is interesting...

[a1] = "=K2&""-""&L2&""-""&M2&""-""&N2&""-""&O2=""" & Join([k2:o2&""], "-") & """"

What sets it back to false when the numbers change?

I adapted the idea to...

    Dim pass As String
    pass = [k2] & [l2] & [m2] & [n2] & [o2]
    If [a1] = pass Then Exit Sub
    [a1] = pass
    'Rest of code...

[大灰狼1976]

@paulked!

Although it's really interesting, but I'm sure that sets it back to false when the numbers change.

You can have a try.

A simple example for testing.

But...But, I think your method is better.

--Okami

[SamT]

I manually enter them.

Forget the updatebutton, by the time you have typed in the next reference number, this code will already have the previous number's section updated. I know you know this, but, this code goes in the worksheet's code page.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Calc As Long
With Application
   Calc = .Calculation
   .Calculation = xlCalculationManual
   .ScreenUpdating = False
   .EnableEvents = False
End With
On Error GoTo SafeClose


   If Not Intersect(Target, Range("K2:O2")) Is Nothing Then SamT_AutoUpdate Target
   

SafeClose:
With Application
   .Calculation = Calc
   .ScreenUpdating = True
   .EnableEvents = True
End With
End Sub


Private Sub SamT_AutoUpdate(ByVal Target As Range)
'http://www.vbaexpress.com/forum/showthread.php?66142-copy-multiple-rows-of-numbers-to-new-location-on-same-sheet

Dim ActiveSection As Range
Dim Cel As Range

    Set Cel = Range("A:A").Find(Target)
      'I sure hope my counts are correct/ Include only the columns to be updated 
      '   and all the rows in both top and bottom sections.
    Set ActiveSection = Range(Cel.Offset(0, 1).Cel.Offset(33, 30))
    With ActiveSection
           'Move (Cut+Insert) the last row to the first row, thus moving all the rest down one
           'Then paste the new data over the moved data
        .Rows(12).Cut (.Rows(1))
        .Rows(14).Copy .Rows(1)
        .Rows(29).Cut (.Rows(18))
        .Rows(15).Copy .Rows(18)
    End With
End Sub

[paulked]

Nice move Sam

@Big Wolf (I hope Google Translate hasn't let me down... again! ) Genius, it didn't work when i first tried it, but it was my fault as I had Calculations in manual after jumping out of some other code!!

[SamT]