Solved: Amend and Move

[Hoopsah]

Hi

I currently have a spreadsheet where, if I type in a reference number it will bring in all the instances of the records from another sheet to display.

I want to be able to amend the details then send it back to the original worksheet, however, If 1 column has been updated to show job complete then it should move the record into a new sheet, and show the date that it was updated.

I have been having limited success with the amendments but I am getting confused as there can be quite a few seperate records on display

Hope this makes sense - I have attached a copy of the sheet so far,

Any help will be welcomed.

[Bob Phillips]

Add this code to your edit sheet code module

[vba]

Option Explicit

Private thisFormula As String

Private Sub Worksheet_Change(ByVal Target As Range)
Dim wsDB As Worksheet
Dim dbId As Long
Dim dbRow As Long
Dim wsComp As Worksheet
Dim compRow As Long

On Error GoTo ws_exit

Application.EnableEvents = False
Application.ScreenUpdating = False

Set wsDB = Worksheets("Database")
Set wsComp = Worksheets("Completed")

dbId = Me.Cells(Target.Row, "A").Value
dbRow = Application.Match(dbId, wsDB.Columns(1), 0)

If Not Intersect(Target, Me.Range("C10:I24")) Is Nothing Then

With Me.Rows(Target.Row)

.Cells(1, "C").Copy
wsDB.Cells(dbRow, "B").PasteSpecial Paste:=xlValues
.Cells(1, "D").Resize(, 2).Copy
wsDB.Cells(dbRow, "D").PasteSpecial Paste:=xlValues
.Cells(1, "F").Copy
wsDB.Cells(dbRow, "G").PasteSpecial Paste:=xlValues
.Cells(1, "G").Copy
wsDB.Cells(dbRow, "F").PasteSpecial Paste:=xlValues
.Cells(1, "H").Resize(, 2).Copy
wsDB.Cells(dbRow, "H").PasteSpecial Paste:=xlValues
End With

Target.Formula = thisFormula
ElseIf Not Intersect(Target, Me.Range("J10:J24")) Is Nothing Then

If IsDate(Target.Value) Then

compRow = wsComp.Cells(wsComp.Rows.Count, "A").End(xlUp).Row + 1
wsDB.Rows(dbRow).Copy wsComp.Cells(compRow, "A")
wsComp.Cells(compRow, "J").Value = Date
wsComp.Cells(compRow, "J").NumberFormat = "dd/mm/yyyy"
wsDB.Rows(dbRow).Delete
Target.Value = ""
End If
End If

ws_exit:
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, Me.Range("C10:I24")) Is Nothing Then

thisFormula = Target.Formula
End If
End Sub
[/vba]

[Hoopsah]

Hi Bob

you will need to forgive me here.

I have copied the code into the worksheet, but I can't see what it is doing or how to make it respond.

Sorry if I am being thick!

[Bob Phillips]

Gerry,

If you have put that code in the correct worksheet module, behind the Edit sheet, just change any value in C10:I24 on the Edit sheet and it will update the Database sheet. Put a date in J10:J24, and it moves it from Database to Completed and remove it from database.

[Hoopsah]

Right, I must be being thick!!

I copied the code into the "View Code" of the tab Edit-Existing

I have tried inputting a date and nothing changes.

I have put it in the wrong place?

[Bob Phillips]

Post your updated workbook Gerry and let me see it.

[Hoopsah]

Hi Bob

attached the updated version

[Bob Phillips]

The code is in a standard code module Gerry, not the Edit worksheet code module.

[Hoopsah]

Sorry Bob,

I tried the code in a module too and still couldn't make it do anything!!

[Bob Phillips]

Take a look at this

[Hoopsah]

That is fantastic Bob,

I was obviously putting the code in the wrong place again.

Works Perfectly,

Thanks for your help (And your Patience)

Cheers Bob

Marking as Solved.

[Bob Phillips]

Untested Gerry, but it should be

[vba]
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, Me.Range("C10:I24")) Is Nothing Then
thisFormula = Target.Formula
Exit Sub
ElseIf Target.Address = "$J$10:$J$24" Then

Call OpenCalendar
End If
End Sub
[/vba]

[Hoopsah]

Hi Bob

Thanks for answering.

Tried the code and I'm afraid the calender doesn't pop up and also if I type in a Date then it clears the whole page.

[Bob Phillips]

Can you post the workbook Gerry?

[Hoopsah]

Hi Bob

copy attached.

No Pop up for column J, but when I type in a date the record is moved into the correct tab, but the page then clears and won't re-populate when you type the reference in again.

Cheers

Gerry

[Bob Phillips]

That was a toughie

[vba]
Option Explicit

Private thisFormula As String

Private Sub Worksheet_Change(ByVal Target As Range)
Const FORMULA_ROW As String = _
"=IF(ISERROR(SMALL(IF((Database!$C$1:$C$500=$H$6),ROW($A$1:$A$500),""""),RO W($A1))),""""," & vbLf & _
"INDEX(Database!$A$1:$A$500,SMALL(IF((Database!$C$1:$C$500=$H$6),ROW($A$1:$ A$500),""""),ROW($A1))))"
Dim wsDB As Worksheet
Dim dbId As Long
Dim dbRow As Long
Dim wsComp As Worksheet
Dim compRow As Long

On Error GoTo ws_exit

Application.EnableEvents = False
Application.ScreenUpdating = False

Set wsDB = Worksheets("Database")
Set wsComp = Worksheets("Completed")

dbId = Me.Cells(Target.Row, "A").Value
dbRow = Application.Match(dbId, wsDB.Columns(1), 0)

If Not Intersect(Target, Me.Range("C10:I24")) Is Nothing Then

With Me.Rows(Target.Row)

.Cells(1, "C").Copy
wsDB.Cells(dbRow, "B").PasteSpecial Paste:=xlValues
.Cells(1, "D").Resize(, 2).Copy
wsDB.Cells(dbRow, "D").PasteSpecial Paste:=xlValues
.Cells(1, "F").Copy
wsDB.Cells(dbRow, "G").PasteSpecial Paste:=xlValues
.Cells(1, "G").Copy
wsDB.Cells(dbRow, "F").PasteSpecial Paste:=xlValues
.Cells(1, "H").Resize(, 2).Copy
wsDB.Cells(dbRow, "H").PasteSpecial Paste:=xlValues
End With

Target.Formula = thisFormula
ElseIf Not Intersect(Target, Me.Range("J10:J24")) Is Nothing Then

If IsDate(Target.Value) Then

compRow = wsComp.Cells(wsComp.Rows.Count, "A").End(xlUp).Row + 1
wsDB.Rows(dbRow).Copy wsComp.Cells(compRow, "A")
wsComp.Cells(compRow, "J").Value = Date
wsComp.Cells(compRow, "J").NumberFormat = "dd/mm/yyyy"
wsDB.Rows(dbRow).Delete

Me.Range("A10").FormulaArray = FORMULA_ROW
Me.Range("A10").AutoFill Me.Range("A10:A24")
End If
End If

ws_exit:
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Count = 1 Then
If Not Intersect(Target, Me.Range("C10:I24")) Is Nothing Then
thisFormula = Target.Formula
Exit Sub
ElseIf Not Intersect(Target, Me.Range("J10:J24")) Is Nothing Then

Call OpenCalendar
End If
End If
End Sub
[/vba]

[Hoopsah]

Glad you thought so!!

Works perfectly Bob, I have added a line just to clear the contents of column J once a date has been selected, but once again your help has been wonderful.

Thanks again Bob

Gerry

[Hoopsah]

Hi Bob,

I know I have a cheek asking here, but part of the code doesn't work:

[VBA]Me.Range("A10").FormulaArray = FORMULA_ROW
Me.Range("A10").AutoFill Me.Range("A10:A24") [/VBA]

When I add a date, the row gets moved to the correct spreadsheet, but the formula:

[VBA]"=IF(ISERROR(SMALL(IF((Database!$C$1:$C$500=$H$6),ROW($A$1:$A$500),""""),RO W($A1))),""""," & vbLf & _
"INDEX(Database!$A$1:$A$500,SMALL(IF((Database!$C$1:$C$500=$H$6),ROW($A$1:$ A$500),""""),ROW($A1))))[/VBA]

on the spreadsheet counts down by 1 - C1:C499 and of course, doesn'y display any data.

Any Ideas?

[Bob Phillips]

When you say add a date Gerry, do you mean inserting a row on the database workshet, or do you mean inserting a date in column J?

Can you post your latest workbook so we are in sync?

[Hoopsah]

Hi Bob

thanks for looking at this again.

The problem is within the search tabs.

When you add the date into column J, the record is moved into the appropriate worksheet, but then the formula in column A changes and then the array values are not the same so nothing shows.

I have attached the whole workbook so that you can see everything I am doing, but the problem lies within each search tab - Search_Developer_Complete, Search_Ref_Complete, Search_Team_Complete etc.

Cheers Bob