Automatically transferring of rows between worksheets in Excel 2010

nunny1982

New Member
Joined
Oct 29, 2013
Messages
15
Afternoon All,

New joiner here so please be patient as I try and explain what I am trying to do! I currently have a work book with mulitple worksheets and on two of these I have identical tables. On one of them I have a risk register and I am trying to make it so that only open risks are on here. I would like to be able to make Excel automatically transfer the entire row to the other table when the 'open/closed' box is changed to 'closed'.

I have tried googling it and have found a few similar queries; however the code given does not seem to work in my case (maybe an older version of Excel - I'm not sure)

Is anyone able to help me with this at all?

Many thanks in advance for any help given.
 
I've tried that and I get the run-time error again. When I click debug the red text below is highlighted:


Private Sub Worksheet_Change(ByVal Target As Range)

Dim LastOpenRow As Double
Dim WsAct2 As Worksheet
Dim OpenClosed As Range

Set WsAct2 = ThisWorkbook.Sheets("Risk")
LastOpenRow = WsAct2.Range("B" & Rows.Count).End(x1Up).Row
Set OpenClosed = WsAct2.Range("K2:K" & LastOpenRow)
For Each DC In OpenClosed 'add date to column L
If UCase(DC.Value) = "CLOSED" Then DC.Offset(0, 1).Value = Now
Next DC
For Each OC In OpenClosed 'copy row to other sheet
If UCase(OC.Value) = "CLOSED" Then OC.Offset(0, -8).Resize(1, 13).Copy Destination:=ThisWorkbook.Worksheets("Closed risks").Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
Next OC
For Each DR In OpenClosed 'delete rows (separate FOR because else copy For will be corrupted)
If UCase(DR.Value) = "CLOSED" Then DR.EntireRow.Delete
Next DR

End Sub


am basically trying to do exactly the same as before yes apart from the extra column and I have renamed some of the other columns (but none that should be affected by the above?
 
Upvote 0

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
Ah! appears you've got a typo! End(x1Up).Row there's an 1 instead of a L it's End(XLUP).row

but okay.. the previous question for auto-numbering:

This code will check in columns B of both sheets "Actions" & "Closed actions" for the highest ID no., adds 1... you'll see... when you enter a description in any row. I'd problably could have make it work on any other cell in that row too, but I think in normal user behaviour the description is never left out.

Paste the code in the corresponding ("Actions") sheet-programcode underneath the end sub of the other code and you're good to go!

Code:
Private Sub Worksheet_Change(ByVal Target As Range)


'Apply autonumber to column B in sheet "Actions" when Column D "Description" has a value
Dim WsAct As Worksheet
Dim lMax As Long
Dim R As Range, cell As Range


Set WsAct = ThisWorkbook.Sheets("Actions")
    
    lMax = WorksheetFunction.Max(Sheets("Actions").Range("B:B"), Sheets("Closed actions").Range("B:B"))
    Count = lMax
    reslrowS = WsAct.Cells(Rows.Count, 2).End(xlUp).Row 'last rowno. column B
    reslrowE = WsAct.Cells(Rows.Count, 4).End(xlUp).Row 'last rowno. column D
    
    Set R = WsAct.Range(Cells(reslrowS, 2), Cells(reslrowE, 2))
    
     
    For Each cell In R
     
     If cell.Value = "" Then Count = Count + 1
     If cell.Value = "" Then cell.Value = Count
   Next
End Sub
 
Upvote 0
That code is great! Thanks very much. The numbering is exactly how I was trying to make it :)

The previous issue is still there though :( I have corrected the typo and now it copies all the cells with the exception of column B which is the 'No.' column. This causes Excel to then crash as it pastes information into the wrong cells on the other sheet. I am not sure if having that extra column has caused it range to be put out?
 
Upvote 0
It did! It did! :p

If UCase(OC.Value) = "CLOSED" Then OC.Offset(0, -9).Resize(1, 14).Copy
--------
I know how hard it is to follow the steps which are created by others. There allways are about 3-4 different ways to set up. You'll allways have te try follow the logic steps someone else made. What does it do, what? Why? What does that specific part do?
--------
In my logic this is what happens in the code

Private Sub Worksheet_Change(ByVal Target As Range)

Dim LastOpenRow As Double
LastOpenRow is just a name with a numeric value (f.i. 1,2,3..11) which will later be used as the number of the last row that's used in the sheet "active"
Dim WsAct2 As Worksheet
WsAct2 is a short name that later can be used as a sheetname
Dim OpenClosed As Range
OpenClosed is a short name that later can be used as a Range

all above itself doesn't do anything for itself, it only to let VBA know what you are going to do with some of the variables you're going to create

Set WsAct2 = ThisWorkbook.Sheets("Risk")
From this point of the code you use a shortname, WsAct2 instead of ThisWorkbook.Sheets("Risk")
LastOpenRow = WsAct2.Range("B" & Rows.Count).End(xlUp).Row
From this point you'll use a name for a rownumber. The name is easy to remember and you'll be able to remember what some functions do after a few weeks. What does WsAct2.Range("B" & Rows.Count).End(xlUp).Row do? In sheet WsAct2 (earlier set as the shortname for sheet "Risk") excel will go to the last to be counted cell of column B (B1048567, way down) and then go up to the last cell which contains something (formula or value). Now excel knows what's the last used row if Column B is representative to the rest of the data. Allways use a column that you'll be certain it must be used.

Set OpenClosed = WsAct2.Range("K2:K" & LastOpenRow)
OpenClosed is the range of cells (K2 to K16,17,21,41 or how long it'll be) Because you've setup that the range of cells starts in Row 2 (K2) and ends at the last row you've setup with LastOpenRow you'll know which cells can contain the word you're gonna look into. If you'll have 10 active rows (rows 2:11) there will be 10 cells in the range OpenClosed.

For Each DC In OpenClosed 'add date to column L
This one's tricky, now there's a DC in the code which isn't mentioned as a variable before. VBA just accepts it as: For each 'Cell in the range OpenClosed <f.i. the 10 in the previous line, or less/more> the user is telling me that it's called DC. I've just used DC, but I could also have used DataaddingCell of Saucage.. doesn't matter.

For Each will say VBA will do something for you, for each cell you want it to do something, in this case it'll do exactly thesame for all 10 cells

If UCase(DC.Value) = "CLOSED" Then DC.Offset(0, 1).Value = Now

This step does this: The value of DC (1st cell of range, 2nd cell of range, 3rd... 11th..) is converted to all UPPERCASES and checked if that's "CLOSED". If it is? Then go 0 cells down and 1 cell to the right and insert the date and time it is NOW
Next DC
This will tell to go to the next cell in the Range OpenClosed. Now the next cells will be named DC for VBA. It'll stop looping to If UCase(DC... until it reaches the last cell in the range

For Each OC In OpenClosed 'copy rowto other sheet
* as above
If UCase(OC.Value) = "CLOSED" Then OC.Offset(0, -9).Resize(1, 14).Copy
If the value is "closed" then go 9 cells to the left of the active OC-cell in the range and expand the selection so it'll be 1 row high and 14 rows wide.Destination:=ThisWorkbook.Worksheets("Closed risks").Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
This line can't be on a separate code-line, but should be directly after .Copy. Never use enter between them.
It tells VBA where to paste the copied data to. In this case: thisworkbook, sheet "Closed risks", in column B, goto the bottom of that Column (B1048567), go back up to the last cell in column B which contains data and after that 1 cell down. (or it will overwrite the data in the last row).
Next OC
*as above
For Each DR In OpenClosed 'delete rows (separate FOR because else copy For will be corrupted)
If UCase(DR.Value) = "CLOSED" Then DR.EntireRow.Delete


when you're a bit further in VBA you'll learn another way to implement these things in one FOR EACH function. I've created it seperately to make you better understand what's happening. This FOR EACH will determine to which rows to be deleted. To make it work, you'll allways have to make sure VBA runs the range backwards. From bottom to top. In this case it doesn't matter, but you can imagine that when you delete a row in the middle of a loop of functions the range will be adapted and it will corrupt. When you work backwards it won't matter.

Next DR


End Sub


Hope it makes sense!


 
Upvote 0
That is a really useful explanation. Thanks! I shall save that for the next time too :)

I thought it must have been the range! I did try amending it but only up to 13 (so close!). It now copies the row across but then it crashes again and does not delete the original row? The coding I have is:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim LastOpenRow As Double
Dim WsAct2 As Worksheet
Dim OpenClosed As Range

Set WsAct2 = ThisWorkbook.Sheets("Risk")
LastOpenRow = WsAct2.Range("B" & Rows.Count).End(xlUp).Row
Set OpenClosed = WsAct2.Range("K2:K" & LastOpenRow)
For Each DC In OpenClosed 'add date to column L
If UCase(DC.Value) = "CLOSED" Then DC.Offset(0, 1).Value = Now
Next DC
For Each OC In OpenClosed 'copy row to other sheet
If UCase(OC.Value) = "CLOSED" Then OC.Offset(0, -9).Resize(1, 14).Copy Destination:=ThisWorkbook.Worksheets("Closed risks").Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
Next OC
For Each DR In OpenClosed 'delete rows (separate FOR because else copy For will be corrupted)
If UCase(DR.Value) = "CLOSED" Then DR.EntireRow.Delete
Next DR

End Sub


I cannot see why it would be causing it to crash?
 
Upvote 0

Forum statistics

Threads
1,214,641
Messages
6,120,693
Members
448,979
Latest member
DET4492

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