Solved: tricky copy and paste macro

[Pete]

see attached workbook
Hi

Need a macro that will copy the data from the raw data worksheet "Task_Table1" and paste it into the visible worksheet"Latin_America_Santander" (other worksheet are hidden for the time being).

The macro to run from the Update table macro button in worksheet "Latin_America_Santander"

The row of data we are concerned with here is A5:J20... Also note the heading in both worksheets are the same.

The trick to this macro is column E "Baseline Finish"

I have already insert the first data as an example.....this need to be removed and replaced with correct data.

Here is the sequence:

1. Copy only the task that have a RBS_ code in column A

2. Copy and paste the data into worksheet "Latin_America_Santander" into the current tables (there are three tables in the worksheet - the difference being the dates. First table relates to task due on the 27/11/2008, the second relates to task due between 27/11/08 - 04/12/08..

3. So look at the date in column E worksheet "Task_Table1", copy and paste the data into the corresponding table in worksheet"Latin_America_Santander"

4. data is copied and pasted into the corresponding headers...

[Bob Phillips]

How do you know that LATAM SANTANDER items go to the Latin_America_Santander worksheet?

I don't see where the items you have added come from. Why Asia in LATAM for instance? Where is Dennis Joes and the RAG details?

[Pete]

Hi xld

1. How do you know that LATAM SANTANDER items go to the Latin_America_Santander worksheet? - beacuse they do - simple as.

2. I don't see where the items you have added come from. - These are exmaples not real data from the worksheet.

3. Why Asia in LATAM for instance? - Again an example of - ignore kindly lease

4. Where is Dennis Joes and the RAG details? - These will be mannually keyed in.

i hope this shed some light on the question.

[Bob Phillips]

1. How do you know that LATAM SANTANDER items go to the Latin_America_Santander worksheet? - beacuse they do - simple as.

That may be so, but that is more than a tad difficult to program, it is impossible. There has to be a cue somewhere, something that the code can associate.


2. I don't see where the items you have added come from. - These are exmaples not real data from the worksheet.

3. Why Asia in LATAM for instance? - Again an example of - ignore kindly lease

4. Where is Dennis Joes and the RAG details? - These will be mannually keyed in.

i hope this shed some light on the question.

Okay, but more realistic data would help save time.

[Pete]

That may be so, but that is more than a tad difficult to program, it is impossible.

There has to be a cue somewhere, something that the code can associate. - could we use the RBS_CNY code as they are unique to Latam_Santander

As they are differenet to Wonderwall for example

[Bob Phillips]

You could use any number of ways, but there has to be some rule and preferably some data somehwere that can be queried, to make it flexible and not hard-coded.

[Pete]

You could use any number of ways, but there has to be some rule and preferably some data somehwere that can be queried, to make it flexible and not hard-coded. - of the top of my head, i have no answer.

But other than the uniquie id field RBS_CNY unless you have a better idea.

[Bob Phillips]

Well, I had one idea. Could you change the name of the target sheet to the value that is column B, LATAM SANTANDER for instance, or change the lable in column B to the worksheet name.

Should there also be North America and Wonderwall sheets with those items with a TCIP Ref.

[Pete]

Could you change the name of the target sheet to the value that is column B, LATAM SANTANDER for instance, or change the lable in column B to the worksheet name. - yes i am happy with that idea....i have no problems with you excelllent suggestion.

Should there also be North America and Wonderwall sheets with those items with a TCIP Ref. - yes....fine with me

[Pete]

Hi

Any insight into the question

[Bob Phillips]

It is not a question of whether it is fine with you, it is more a question of what is the actual situation. The code needs to know what the rules are so that it can act appropriately. Does it ignore anything for which there is no sheet, always assume there will be a sheet, create a sheet bases upon a template or what. These are basic user requirements that you have to determine.

[Pete]

hi xld

Does it ignore anything for which there is no sheet - There will be a work sheet for all situation other wise ignore data.

always assume there will be a sheet, create a sheet bases upon a template - once again i ahve created all the worksheet...

At present i am trying to see if it'll work with the section of data with the smallest data to transfer across from "task_table1" worksheet to Latam_Santander worksheet.

[rbrhodes]

At present i am trying to see if it'll work with the section of data with the smallest data to transfer across from "task_table1" worksheet to Latam_Santander worksheet.

Here's an example based on the above statement. It will only work once as it doesn't clear old data, etc, etc,

Is this what you're looking for?

[Pete]

Hi dr

Thanks for your execellent feedback....i will test and report back SIR

[Pete]

Hi Dr.........

the code works prefectly fine just one amendment......and its 100%.....
i'll post the reply - once i have thought about it....

[Pete]

3. Within Worksheet"Latam Santander" there are three table:-
i. Table A:- see row 13 - enter only data that has the date of the 29th november 2008
ii. Table B:- see row 26 - enter only data that has the date of the 29th november 2008-06th december 2008
iii. and table C: row 39 etc........

there is only one problem and thats it...

The dates from worksheet"Task_Table1" are not going to the right tables in worksheet "Latam Santander".....as outlined in the origianl question above.

let me up load a new workbo

[Pete]

3. Within Worksheet"Latam Santander" there are three table:-
i. Table A:- see row 13 - enter only data that has the date of the 29th november 2008
ii. Table B:- see row 26 - enter only data that has the date of the 29th november 2008-06th december 2008
iii. and table C: row 39 etc........

there is only one problem and thats it...

The dates from worksheet"Task_Table1" are not going to the right tables in worksheet "Latam Santander".....as outlined in the origianl question above.

let me up load a new workbook with all the date in column E worksheet "task_table1" all sorted in date order....

i

[Pete]

A point to note...

The vba code is not in the worksheet"Latam_Santander" module...... i just removed it to look at it....

[rbrhodes]

Hi Pete,

So Table 1 should only have rows that are todays date. Is that what you mean?

[Pete]

So Table 1 should only have rows that are todays date. Is that what you mean? - yes if there are any dates with todays dates - in worksheet "Task_Table1" column E..

if there are non then move to the next table and see if any dates lie there - if yes add. if no move to final tables etc...... and so on.

[rbrhodes]

Hi Pete,

Here's ver 2. It has a lot more stuff in it (much more than I intended!)

I just spent a few hours on this...oh well!

It's briefly tested. I have to go earn a living now...

[Pete]

Cheers.......dr...

this is the only difficult question i have asked and once again thank you sir.

[Pete]

Hi dr

i cannot open the zipped file you send across......can you kinldy post the VBA Code here please.

[rbrhodes]

Here 'tis

[Pete]

Hi dr....

cannot get the excellent piece of VBA Coding that you did for me to work......

Option Explicit
Sub Updater()
Dim Cel As Range
Dim Rng As Range
Dim dDate As Date
Dim Date1 As Date
Dim Date2 As Date
Dim Date3 As Date
Dim dRow1 As Long
Dim dRow2 As Long
Dim dRow3 As Long
Dim Counter As Long
Dim LastRow As Long
Dim FirstRow As Long
Dim StartRow As Long
Dim ThisSheet As String
Dim SheetName As String
Dim WSdest As Worksheet
Dim WSsource As Worksheet

'Speed and recursion
With Application
.EnableEvents = False
.ScreenUpdating = False
End With

'Handle errors
On Error GoTo errOut
'//Should ask for Sheet names?
If Left(ActiveSheet.Name, 4) <> "Task" Then
SheetName = ActiveSheet.Name
Else
GoTo endo
'SheetName = InputBox("Please enter name of destination sheet!", "Sheet name required!")
'//Sheet name needs to be in Select Case as ALL CAPS
End If
'//This is used for search in Task sheet. Using ALL
' CAPS as key to stop search. What else to use? How
' to use it...

'/*Begin User change*/
'Name for search enteres _exactly_ as in Task sheet
Select Case SheetName
Case Is = "Latam_Santander"
ThisSheet = "LATAM SANTANDER"
Case Is = "North_America"
ThisSheet = "NORTH AMERICA"
Case Is = "Wonderwall"
ThisSheet = "WONDERWALL"
Case Else
GoTo endo
End Select
'/*End User change*/

'Create objects
Set WSdest = Sheets(SheetName)

'//Should be selectable?
Set WSsource = Sheets("Task_Table1")
'Get dates
Date1 = WSdest.Range("C2")
Date2 = Date1 + 7
Date3 = Date1 + 56
'Set intial rows

'//This should find 'Milestones' in the Dest sheet
' adding 1 to the found row each of three times
With WSdest.Range("A:A")
Set Cel = .find("Milestones", LookIn:=xlValues)
If Not Cel Is Nothing Then
dRow1 = Cel.Row + 1
For Counter = 2 To 3
Set Cel = .FindNext(Cel)
If dRow2 = 0 Then
dRow2 = Cel.Row + 1
Else
dRow3 = Cel.Row + 1
End If
Next Counter
End If
End With

'//Could use Same search as above with Column B deleting
' rows as needed?

'Get last row of data
LastRow = WSdest.Range("A" & Rows.Count).End(xlUp).Row

'Delete old 3
If LastRow > dRow3 Then
Range(Cells(dRow3 + 1, 1), Cells(500, 11)).EntireRow.Delete
Range(Cells(dRow3, 1), Cells(dRow3, 11)).ClearContents
ElseIf LastRow = dRow3 Then
Range(Cells(dRow3, 1), Cells(dRow3, 11)).EntireRow.Delete
End If

'Get difference
LastRow = (dRow3 - dRow2) - 9
'Delete old 2
If LastRow > 0 Then
Range(Cells(dRow2 + 1, 1), Cells(dRow2 + LastRow, 11)).EntireRow.Delete
Range(Cells(dRow2, 1), Cells(dRow2, 11)).ClearContents
End If

'Get difference
LastRow = (dRow2 - dRow1) - 9
'Delete old 1
If LastRow > 0 Then
Range(Cells(dRow1 + 1, 1), Cells(dRow1 + LastRow, 11)).EntireRow.Delete
Range(Cells(dRow1, 1), Cells(dRow1, 11)).ClearContents
End If

'Reset rows 2 and 3 after deletion. Faster and easier to
' search than do the arithmetic
dRow2 = 0
With WSdest.Range("A:A")
Set Cel = .find("Milestones", LookIn:=xlValues)
If Not Cel Is Nothing Then
dRow1 = Cel.Row + 1
For Counter = 2 To 3
Set Cel = .FindNext(Cel)
If dRow2 = 0 Then
dRow2 = Cel.Row + 1
Else
dRow3 = Cel.Row + 1
End If
Next Counter
End If
End With

'Init for search
FirstRow = 2

'Get last row based on Col B
LastRow = WSsource.Range("B" & Rows.Count).End(xlUp).Row

'Create search range based on Col B
Set Rng = WSsource.Range(Cells(FirstRow, 2).Address, Cells(LastRow, 2).Address)

'Find name
StartRow = Rng.find(What:=ThisSheet, After:=Rng(1), LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, _
SearchFormat:=False).Row + 1
With WSsource
'Copy stuff
For Counter = StartRow To LastRow
'Check if code
If Left(.Cells(Counter, 1), 4) = "RBS_" Then
'Get due date
dDate = .Cells(Counter, 5)
'Check date and copy to appropriate row & insert row for next
If dDate = Date1 Then
With WSdest
'Insert row
.Cells(dRow1 + 1, 1).EntireRow.Insert
'Copy formats
.Cells(dRow1, 1).EntireRow.Copy
.Cells(dRow1 + 1, 1).PasteSpecial Paste:=xlFormats
End With
'//This should be range
'Get data
.Range(Cells(Counter, 1).Address, Cells(Counter, 11).Address).Copy
'.Cells(Counter, 1).EntireRow.Copy
'Paste data
WSdest.Cells(dRow1, 1).PasteSpecial Paste:=xlValues
'Update
dRow1 = dRow1 + 1
dRow2 = dRow2 + 1
dRow3 = dRow3 + 1
ElseIf dDate > Date1 And dDate < Date2 Then
With WSdest
'Insert row
.Cells(dRow2 + 1, 1).EntireRow.Insert
'Copy formats
.Cells(dRow2, 1).EntireRow.Copy
.Cells(dRow2 + 1, 1).PasteSpecial Paste:=xlFormats
End With
'//This should be range
'Get data
.Range(Cells(Counter, 1).Address, Cells(Counter, 11).Address).Copy
'.Cells(Counter, 1).EntireRow.Copy
'Paste data
WSdest.Cells(dRow2, 1).PasteSpecial Paste:=xlValues
'Update
dRow3 = dRow3 + 1
ElseIf dDate > Date2 And dDate < Date3 Then
With WSdest
'Insert row
.Cells(dRow3 + 1, 1).EntireRow.Insert
'Copy formats
.Cells(dRow3, 1).EntireRow.Copy
.Cells(dRow3 + 1, 1).PasteSpecial Paste:=xlFormats
End With
'//This should be range
'Get data
.Range(Cells(Counter, 1).Address, Cells(Counter, 11).Address).Copy
'.Cells(Counter, 1).EntireRow.Copy
'Paste data
WSdest.Cells(dRow3, 1).PasteSpecial Paste:=xlValues
'Update row
dRow3 = dRow3 + 1
End If

'Check if done(Col B is all caps!)
Else
If .Cells(Counter, 2) <> "" And .Cells(Counter, 2) = UCase(.Cells(Counter, 2)) Then
Exit For
End If
End If
Next Counter
End With

'Reset
With Application
.EnableEvents = True
.ScreenUpdating = True
.CutCopyMode = False
End With

'Destroy objects
Set Cel = Nothing
Set Rng = Nothing
Set WSsource = Nothing

'Normal exit
endo:
Exit Sub

'Errored out
errOut:
'Reset
With Application
.EnableEvents = True
.ScreenUpdating = True
.CutCopyMode = False
End With

Counter = MsgBox(Err.Number & " " & Err.Description, vbCritical)
'Destroy objects
Set Cel = Nothing
Set Rng = Nothing
Set WSsource = Nothing

End Sub

[Pete]

Hi dr...

firstly, small apologie the macro work but its missing out some data from the Worksheet"Task_table1"....when it copy the information over to the individual worksheet(s)...

[rbrhodes]

Hey XLD,

"Pete" asked me to delete stuff, claiming you did hem but missed one. I see no options for me to edit my posts.??

Thanks

dr

[Pete]

Hi Rhodes

it was ken puls, who advise me to ask you the workbook is in this question page 2 on this link http://www.vbaexpress.com/forum/showthread.php?t=23846&page=2

i have been in contact with the admin department i am asking you to remove the workbok from the public demain as i have been asked by the Royal Bank of Scotland to do so and there internal security department.

regards

[Pete]

here is the email from ken puls (see attached)

-----Inline Attachment Follows-----


Pete,

Has this been taken care of? I see that rbrhodes has posted some solutions. You'll need to contact him directly (via PM) to have him take down his links.

From what I can see though, your workbook attachments appear to be gone.

Ken Puls, CMA - Microsoft MVP (Excel)
Senior Administrator
www.vbaexpress.com (http://www.vbaexpress.com/)