Solved: Copy data from one Spreadsheet to another and validate

[anthony20069]

Hi,

Was wondering if someone could help out please.....

I have attached a sample spreadsheet to which will help with my explanation.

What Iam trying to do is - within a workbook (wb1 for this) there are a list of project names, title, number etc and like RAG status to show what each project is in and other various information.

What Iam trying to do, is have a button that when clicked, ONLY the project title,name and number are transfered into a NEW workbook (wb2). Within wb2 it should show the project name etc as well as the current status "RED", "AMBER", "GREEN" and the criteria to why it is at that status...

how this and the smaple makes sense..

thanks.

Anthony

[austenr]

Gonna need more info to solve this.

[rbrhodes]

Hi Anthony#

First I figured *homework* but I took a look. Logi***** sounds for real, so here ya go.

Code is unprotected and well commented but is based on a lot of assumptions and has no errorhandling, etc.

[anthony20069]

Wow, cheers rbrhodes, works like a charm, i should be able to edit the VBA. Cheers for that...

*************************
Edit

rbrhodes - again, thanks for the help, one more question

Been trying to make the value appear as well as the criteria
[VBA].Cells(FirstRow, i) = OldBook.Cells(j, 1)[/VBA]

E.g. Reason - Criteria 1 + "what ever the value in the cell is"

hope that makes sense..

Thanks

[rbrhodes]

Hi,

Since j is the row and i is the column change the 3 'Put lines by adding the cell address as follows:

Add:

& " " & .cells(j,i)

where the " " is a space between criteria and value. Could be " & " or " plus " or whatever you want...


[VBA]
'Put
.Cells(FirstRow, i) = OldBook.Cells(j, 1) & " " & OldBook.Cells(j, i)

[/VBA]

[anthony20069]

- was trying with the "+" sign , (fail :P)

cheers for your help.

[anthony20069]

Sorry for the double post

**************************************

Help needed again rbrhode,

I have added in new "criteria" and have attempted to edit the code to match the new row ranges etc - but when the report is run, only the Project Title, Name & Code as well as Current Status and Reason are copied across, no values etc are copied. Any idead?

[rbrhodes]

Hi A,

I didn't build it with ranges, just the 'For' loops and they are the only thing you need to change.

As is:

[VBA]
'Red with 4 criteria
For j = 12 To 15

'Amber with 4 criteria
For j = 17 To 20

'Green with 4 criteria
For j = 22 To 25

[/VBA]

With two rows added to each:

[VBA]
'Red with 6 criteria
For j = 12 To 17

'Amber with 6 criteria
For j = 19 To 24

'Green with 6 criteria
For j = 26 To 31

[/VBA]

Could be changed to be ranges (slightly faster) but right now it's tres simple.

[rbrhodes]

To Columns..

[anthony20069]

thanks a lot rbrhodes.... greatly appreciated, last cheeky question ... how you do make it so that it also puts the value of the cell, tried with what u showed me above, but it just breaks

[rbrhodes]

I think you mean:

[VBA]
'Red
For Each cel In rRng
If cel <> "" Then
'Put: OldBook column = NewBook row
.Cells(i, 4) = "Red"
.Cells(i, 6) = 1
If .Cells(i, 5) = "" Then

'//Added
.Cells(i, 5) = OldBook.Cells(cel.Row, 1) & " + " & OldBook.Cells(cel.Row, cel.Column)
Else
'//Added
.Cells(i, 5) = .Cells(i, 5) & " + " & OldBook.Cells(cel.Row, 1) & " + " & OldBook.Cells(cel.Row, cel.Column)
End If
'Mark as done
GotColour = True
End If
Next cel

'Are we done?
If GotColour = True Then GoTo DoneColour

'Amber
For Each cel In aRng
If cel <> "" Then
'Put: OldBook column = NewBook row
.Cells(i, 4) = "Amber"
.Cells(i, 6) = 2
If .Cells(i, 5) = "" Then
'//Added
.Cells(i, 5) = OldBook.Cells(cel.Row, 1) & " + " & OldBook.Cells(cel.Row, cel.Column)
Else
'//Added
.Cells(i, 5) = .Cells(i, 5) & " + " & OldBook.Cells(cel.Row, 1) & " + " & OldBook.Cells(cel.Row, cel.Column)
End If
'Mark as done
GotColour = True
End If
Next cel

'Are we done?
If GotColour = True Then GoTo DoneColour

'Green
For Each cel In gRng
If cel <> "" Then
'Put: OldBook column = NewBook row
.Cells(i, 4) = "Green"
.Cells(i, 6) = 3
If .Cells(i, 5) = "" Then
'//Added
.Cells(i, 5) = OldBook.Cells(cel.Row, 1) & " + " & OldBook.Cells(cel.Row, cel.Column)
Else
'//Added
.Cells(i, 5) = .Cells(i, 5) & " + " & OldBook.Cells(cel.Row, 1) & " + " & OldBook.Cells(cel.Row, cel.Column)
End If
End If
Next cel
'Red or amber come here right away
DoneColour:

[/VBA]

The 6 lines marked //Added have values addded to them. Replace the lines in your copy with the lines above. (Each pair is the same).