VBA: Excel - automatically copying rows from one sheet to another based on user input

[sitko]

Hi,

I have an Order tracking spreadsheet that I need help with.

I have a 2 worksheets "Open", and "Closed".

I have entries on the "Open" sheet which may or may not be grouped together. I've called the rows :Parents and Children. There are basically 3 types of rows. Parents with Children, Parents without Children, and Children. I have a reference cell for each row, where I identify what type of row it is, "-1" = Child, "0" = Parent with no Children, and (a number > 1) is a parent with that many children. If an entry contains just 1 detail item, the detail data is stored in the Parent row (with no children), if an entry has 2+ detail items, each of the sub items is stored on a Child Row, and is Grouped below the parent row.

The User of this spreadsheet will put an "X" into a cell to specify that it is closed. For Parents with no children, and Children rows, I just run a Worksheet Change event that copies them over Like this:
Code:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim wb As Excel.Workbook
    Dim oDataWS_O As Worksheet
    Dim oDataWS_C As Worksheet
    Dim startRow as Integer
    Dim bfound as boolean
    dim entryRow as Integer

    
    Set wb = ActiveWorkbook
    Set oDataWS_O = wb.Worksheets("Open")
    Set oDataWS_C = wb.Worksheets("Closed")
    
'This is the start of the Moving rows to closed sheets sub

    'Do nothing if more than one cell is changed or content deleted
    If Target.Cells.Count > 1 Or IsEmpty(Target) Or Target.Cells.Value <> "X" Then Exit Sub
    If Not Intersect(Target, Range("C1:C65000")) Is Nothing Then
        If Target.Cells(Target.Row, 79) = -1 Then  'a child
            Exit Sub
        End If
        If Target.Cells(Target.Row, 79) = 0 Then 'a child-less parent
            startRow = 3
            bfound = False
            Do Until oDataWS_O.Cells(startRow, 5) = ""
                If oDataWS_O.Cells(startRow, 5) = "Reference" Then
                    entryRow = startRow
                    bfound = True
                    Exit Do
                End If
                startRow = startRow + 1
            'Next
            Loop
            
            'Appending a row to the tracking spreadsheet
            'Rows(CStr(entryRow) + ":" + CStr(entryRow)).Select
            
            'make room for the parent on the closed sheet
            oDataWS_C.Rows(entryRow).Copy
            oDataWS_C.Rows(entryRow).Insert Shift:=xlDown
            
            'Move the parent to the closed sheet
            oDataWS_O.Rows(Target.Row).Cut
            oDataWS_C.Rows(entryRow).Paste
            
    Else
        Exit Sub
    End If
     
End Sub

From reading other posts on this website and other websites, I've read that the Worksheet_Calcu ate Event calls the Worksheet_Chang e event at the end of it. So, would there be a way to take the "target" Row from the Calculate event and pass it to the Worksheet_Chang e event?

With Parents with Children, the user will put an X into each Child row as that item is delivered. The Children items may not arrive at the same time. The Meaningful cells (for this problem) for the parents and Children are as follows:
Parent: B4[=Sum(B5:B7)] C4[=if(B4=3, "X", "") CA4[3](column 79)
Child: B5[=IF(UPPER(C5)=" X",1,0)] C5[blank] CA5[-1]
Child: B6[=IF(UPPER(C6)=" X",1,0)] C6[blank] CA6[-1]
Child: B7[=IF(UPPER(C7)=" X",1,0)] C7[blank] CA7[-1]

Parent (no kids): B8[blank] C8[blank] CA8[0](column 79)

If the user puts an "X" in a child row, the code above ignores that. If the user puts an "X" in a parent with no children row, the row is cut and pasted into the "closed" sheet.

I need help figuring out what I need to add to the Worksheet_Calcu late Event, to pass the target to the Worksheet_Chang e event. One idea I had while I was typing this, was maybe I check if Target.Cells(Ta rget.Row, 79) > 0, and set up a for loop that will loop through each parent and children, and copy them over to the closed sheet.

Any suggestions/ideas or comments are appreciated.

Thanks,
Sitko.

[kadghar]

From reading other posts on this website and other websites, I've read that the Worksheet_Calcu ate Event calls the Worksheet_Chang e event at the end of it. So, would there be a way to take the "target" Row from the Calculate event and pass it to the Worksheet_Chang e event?

No, the Calculate event has no parameters. its possible to save the range of your last Change event or any range you want to, using a public variable
e.g.

[CODE=vb]public a as range
sub worksheet_chang e(target as range)
set a = target
'everything else
end sub[/CODE]

this way, the range will be stored in a, and you can chage it the way you want to.

With Parents with Children, the user will put an X into each Child row as that item is delivered. The Children items may not arrive at the same time.
(...)
If the user puts an "X" in a child row, the code above ignores that. If the user puts an "X" in a parent with no children row, the row is cut and pasted into the "closed" sheet.
(...)
Any suggestions/ideas or comments are appreciated.
Thanks,
Sitko.

Well, let me see if i understood. When you put an "X" on a children, nothing happens. When you put an "X" on a parent without children, its moved to the 'closed' sheet.

And i think that you need that when you put the last "X" on a parent or a children, if this "X" is the last one needed on that "family", the parent and all its children are moved to the 'Closed' sheet, am i right?

Since i dont remember your column names, lets say that in Column A you have -1 if its a children, and a no-negative number that is the number of children a parent has, if its a parent, of course. And in Column B you put the "X".

I think that, without using the Calculate event. In the Change event you can achieve it with something like this:

[CODE=vb]dim i as long
dim j as long
dim k as long
i=target.row
if cells(i,1).valu e = -1 then
do
i = i-1
if cells(i,1).valu e <>-1 then exit do
loop
end if
j = cells(i,1).valu e + 1
k = i
do
if cells(i,2).valu e <> "X" then exit sub
i=i+1
j=j-1
loop until j = 0
'The code for moving rows from k to (i - 1)[/CODE]

Well, i think this might give you a general idea, and it also works for parents without children.
HTH

[sitko]

[CODE=vb]dim i as long
dim j as long
dim k as long
i=target.row
if cells(i,1).valu e = -1 then
do
i = i-1
if cells(i,1).valu e <>-1 then exit do
loop
end if
j = cells(i,1).valu e + 1
k = i
do
if cells(i,2).valu e <> "X" then exit sub
i=i+1
j=j-1
loop until j = 0
'The code for moving rows from k to (i - 1)[/CODE]

Well, i think this might give you a general idea, and it also works for parents without children.
HTH

And your putting this in the Worksheet_Chang e Event? Since you reference 'target.row'? This looks very elegant, thanks...I'll report back if it works. The one question I still have, but this can be figured out by trying it...is will the parents(with kids) formula be updated before this code activates? I'll also post that answer as well...

Thank you very much.
Sitko.

[kadghar]

And your putting this in the Worksheet_Chang e Event? Since you reference 'target.row'? This looks very elegant, thanks...I'll report back if it works. The one question I still have, but this can be figured out by trying it...is will the parents(with kids) formula be updated before this code activates? I'll also post that answer as well...

Thank you very much.
Sitko.

Yes, in the Change event.

And yes, the Calculate is before the Change, and if you make any change during the Change event, you can write CALCULATE to do so.

remember you can always click F2 to enter the Object Browser, there you can see all the methods, subs and events of each object (go to Worksheet, there you might find some other method or event useful to you).

HTH

[sitko]

Thanks again, that worked like a charm.

I had to copy the parts over in reverse order, to get them in the right order. Heres my final code: I gave the variables more meaning full names:

            init_Row = Target.Row
            If Cells(init_Row, 79).Value = -1 Then
                  Do
                      init_Row = init_Row - 1
                      If Cells(init_Row, 79).Value <> -1 Then Exit Do
                  Loop
            End If
            tot_Entries = Cells(init_Row, 79).Value + 1
            parent_Row = init_Row
            Do
                  If Cells(init_Row, 3).Value <> "X" Then Exit Sub
                  init_Row = init_Row + 1
                  tot_Entries = tot_Entries - 1
            Loop Until tot_Entries = 0
            Top_Row = parent_Row
            Bottom_Row = init_Row - 1
            
            y = 3
            bfound = False
            Do Until oDataWS_UC.Cells(y, 5) = ""
                If oDataWS_UC.Cells(y, 5) = "Reference" Then
                    entryRow = y
                    bfound = True
                    Exit Do
                End If
                y = y + 1
            Loop
            
            Do
                oDataWS_UP.Rows(Bottom_Row).Cut
                oDataWS_UC.Rows(entryRow).Insert Shift:=xlDown
                oDataWS_UP.Rows(Bottom_Row).Delete
                Bottom_Row = Bottom_Row - 1
            
            Loop Until Bottom_Row = Top_Row - 1

The "reference" thingy, is left over from a previous programmer, and the users are used to it, so I get to keep that archaic bit.

One problem I've found, in families with more than 1 kid, when they are imported into the tracking sheet, they are grouped, and the grouping button appears ontop of the parent row. But, after they are copied over, it moves the grouping button down below the last kid.

Weird.

And thats what happens if you manually cut a set of grouped rows over as well. Go try it for yourself...I'll wait here.

:)

Thanks again for your help,
Sitko.

[kadghar]

One problem I've found, in families with more than 1 kid, when they are imported into the tracking sheet, they are grouped, and the grouping button appears ontop of the parent row. But, after they are copied over, it moves the grouping button down below the last kid.

Weird.

And thats what happens if you manually cut a set of grouped rows over as well. Go try it for yourself...I'll wait here.

:)

Thanks again for your help,
Sitko.

Honestly i wouldnt use cut-paste, i'd do something like this

[CODE=vb]Dim a
With Worksheets("ope n")
a = Range(.Cells(7, 1), .Cells(8, 4))
End With
With Worksheets("clo se")
Range(.Cells(1, 1), .Cells(2, 4)) = a
End With
Worksheets("ope n").Rows(7 & ":" & 8).Delete[/CODE]

Well i forgot to insert the blank rows in the second worksheet, and instead of 7, 8 and those numbers i used for testing, use the right variables.

HTH

[sitko]

[CODE=vb]Dim a
'insert rows here on the closed sheet.
With Worksheets("ope n")
a = Range(.Cells(7, 1), .Cells(8, 4))
End With
With Worksheets("clo se")
'Or here.
Range(.Cells(1, 1), .Cells(2, 4)) = a
End With
Worksheets("ope n").Rows(7 & ":" & 8).Delete[/CODE]

Well i forgot to insert the blank rows in the second worksheet, and instead of 7, 8 and those numbers i used for testing, use the right variables.

I see. Took me a while to see that "open" and "close" were the names of the sheets, yes, my coffee hasn't kicked in this morning yet.

I'll definitely try this (in the next phase) my boss told me to move on from this issue for now, since the users were manaually cutting and pasting the code prior, so they are 'used' to this problem...I hate writing buggy code...

Thanks again for your help,
theScripts kicked MrExcel's butt.

Sincerely,
Sitko.

[sitko]

Hi,

I'm having a weird error, that wasn't a problem with the code at the beginning. I do some checks before I go into the moving of rows from one sheet to another, here is the code:

  'above this, I just dim the variables
   If Target.Cells.Count > 1 Then Exit Sub
    If IsEmpty(Target) Then Exit Sub
    If Not Intersect(Target, Range("C1:C60000")) Is Nothing Then Exit Sub
    If (UCase(Target.Cells.Value) <> "X") And (UCase(Target.Cells.Value) <> "C") Then Exit Sub
    Application.EnableEvents = False
    If (UCase(Target.Cells.Value)) = "X" Then Target.Cells.Value = "X"
    If (UCase(Target.Cells.Value)) = "C" Then Target.Cells.Value = "C"
    Application.EnableEvents = True
    If Target.Cells.Value = "X" Then
'it then goes into the code above...

When I first had this code, the check against the intersect(Line #4) worked everytime, but now it doesn't. I added the calls to the Disable and enable the events (lines #6 & #9) around the value change, as when I set those, it would RECALL the event, and go into an loop. but, shortly thereafter, the intersect check stopped working. In fact, everytime I would test it, it would exit the sub there.

I'm leaning to just commenting out this code (line #4) and leaving it at that...but figured I'd run it by you to see if you saw anything in particular that could help.

Thanks,
Sitko.

[kadghar]

Hi,

(...)

When I first had this code, the check against the intersect(Line #4) worked everytime, but now it doesn't. I added the calls to the Disable and enable the events (lines #6 & #9) around the value change, as when I set those, it would RECALL the event, and go into an loop. but, shortly thereafter, the intersect check stopped working. In fact, everytime I would test it, it would exit the sub there.
Thanks,
Sitko.

Hi again sitko!

I've checked your code, and syntax seems to be all right. I think the problem could be in the way you're using Intersect, and the way you should want to use it. Remember Intersect will return you a range, if your target is the cell (C20) and you intersect it with (C1:C60000) then the result will be the range(C20). Even if the cells are empty, the intersection won't be 'Nothing', it will be a range.

[sitko]

Hi again sitko!

I've checked your code, and syntax seems to be all right. I think the problem could be in the way you're using Intersect, and the way you should want to use it. Remember Intersect will return you a range, if your target is the cell (C20) and you intersect it with (C1:C60000) then the result will be the range(C20). Even if the cells are empty, the intersection won't be 'Nothing', it will be a range.

OK, I attempted to make make a range variable and set it = to range(target), but that didn't work...so I tried "If Target.Column <> 3 Then Exit Sub" and that worked.

But, apparently something I've recently done, has broken the VBA, in such a way that I can't find...I'm thinking I'll need to go back and re-do all my changes one at a time.

Thanks,
Sitko.