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_Calcuate Event calls the Worksheet_Change 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_Change 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_Calculate Event, to pass the target to the Worksheet_Change event. One idea I had while I was typing this, was maybe I check if Target.Cells(Target.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.
9 16734
From reading other posts on this website and other websites, I've read that the Worksheet_Calcuate Event calls the Worksheet_Change 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_Change 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. - public a as range
-
sub worksheet_change(target as range)
-
set a = target
-
'everything else
-
end sub
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: - dim i as long
-
dim j as long
-
dim k as long
-
i=target.row
-
if cells(i,1).value = -1 then
-
do
-
i = i-1
-
if cells(i,1).value <>-1 then exit do
-
loop
-
end if
-
j = cells(i,1).value + 1
-
k = i
-
do
-
if cells(i,2).value <> "X" then exit sub
-
i=i+1
-
j=j-1
-
loop until j = 0
-
'The code for moving rows from k to (i - 1)
Well, i think this might give you a general idea, and it also works for parents without children.
HTH
- dim i as long
-
dim j as long
-
dim k as long
-
i=target.row
-
if cells(i,1).value = -1 then
-
do
-
i = i-1
-
if cells(i,1).value <>-1 then exit do
-
loop
-
end if
-
j = cells(i,1).value + 1
-
k = i
-
do
-
if cells(i,2).value <> "X" then exit sub
-
i=i+1
-
j=j-1
-
loop until j = 0
-
'The code for moving rows from k to (i - 1)
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_Change 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.
And your putting this in the Worksheet_Change 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
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.
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 - Dim a
-
With Worksheets("open")
-
a = Range(.Cells(7, 1), .Cells(8, 4))
-
End With
-
With Worksheets("close")
-
Range(.Cells(1, 1), .Cells(2, 4)) = a
-
End With
-
Worksheets("open").Rows(7 & ":" & 8).Delete
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
- Dim a
-
'insert rows here on the closed sheet.
-
With Worksheets("open")
-
a = Range(.Cells(7, 1), .Cells(8, 4))
-
End With
-
With Worksheets("close")
-
'Or here.
-
Range(.Cells(1, 1), .Cells(2, 4)) = a
-
End With
-
Worksheets("open").Rows(7 & ":" & 8).Delete
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.
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.
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.
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.
Sign in to post your reply or Sign up for a free account.
Similar topics
by: Allison Bailey |
last post by:
Hi Folks,
I'm a brand new Python programmer, so please point me in the right
direction if this is not the best forum for this question....
I would like to open an existing MS Excel spreadsheet...
|
by: Paul |
last post by:
Hi all
Arggghhh...........
The problem.....I want the user to be able to create an excel document and
name particular cells in the document where they want the data to be placed
and then save...
|
by: Terry Bell |
last post by:
We've had a very large A97 app running fine for the last seven years.
I've just converted to SQL Server backend, which is being tested, but
meanwhile the JET based version, running under terminal...
|
by: RJN |
last post by:
Hi
I've a template excel file which has all the calculations defined. There
are certain input values to be entered which gives a lot of output to
the user. I don't want to expose the excel sheet...
|
by: Striker |
last post by:
I have never used VB, so sorry for the novice questions. I have a very
small app in vba that only uses excel as a place to put a button and some
code that I need to move to VB. Now it seems...
|
by: tarvold |
last post by:
I am new to VBA and am trying to get this project done, so any help would be appreciated.
I am trying to create a userform that will input the total hours worked by an employee into an excel...
|
by: pulavarthipraveen |
last post by:
Overview: We have a requirement in the c#.NET 1.0 windows application. There will be some input text file in the user’s machine. The user should browse and select the input text file and also select...
|
by: TG |
last post by:
hi!
I am trying to create a sql server table from an excel sheet.
Here is the code I have:
'This procedure the xlsx file and dumps it to a table in SQL Server
|
by: provor |
last post by:
Hello,
I have the following code that I am using when a user presses a button to import an excel file into a table. The code is hard coded to point to the correct table. This works great for this...
|
by: ryjfgjl |
last post by:
ExcelToDatabase: batch import excel into database automatically...
|
by: isladogs |
last post by:
The next Access Europe meeting will be on Wednesday 6 Mar 2024 starting at 18:00 UK time (6PM UTC) and finishing at about 19:15 (7.15PM).
In this month's session, we are pleased to welcome back...
|
by: Vimpel783 |
last post by:
Hello!
Guys, I found this code on the Internet, but I need to modify it a little. It works well, the problem is this: Data is sent from only one cell, in this case B5, but it is necessary that data...
|
by: jfyes |
last post by:
As a hardware engineer, after seeing that CEIWEI recently released a new tool for Modbus RTU Over TCP/UDP filtering and monitoring, I actively went to its official website to take a look. It turned...
|
by: ArrayDB |
last post by:
The error message I've encountered is; ERROR:root:Error generating model response: exception: access violation writing 0x0000000000005140, which seems to be indicative of an access violation...
|
by: PapaRatzi |
last post by:
Hello,
I am teaching myself MS Access forms design and Visual Basic. I've created a table to capture a list of Top 30 singles and forms to capture new entries. The final step is a form (unbound)...
|
by: af34tf |
last post by:
Hi Guys, I have a domain whose name is BytesLimited.com, and I want to sell it. Does anyone know about platforms that allow me to list my domain in auction for free. Thank you
|
by: Faith0G |
last post by:
I am starting a new it consulting business and it's been a while since I setup a new website. Is wordpress still the best web based software for hosting a 5 page website? The webpages will be...
|
by: isladogs |
last post by:
The next Access Europe User Group meeting will be on Wednesday 3 Apr 2024 starting at 18:00 UK time (6PM UTC+1) and finishing by 19:30 (7.30PM).
In this session, we are pleased to welcome former...
| |