Values e automatically filled in a different sheet

[Dalia123]

I have a file with 3 sheets, Sheet 2, and 3 have detailed information about the account. with columns Sheet2!A and Sheet2!B corresponds to date and transaction successively.

Same with sheet3 but for different account.
Sheet 2 is dedicated to account #2
Sheet 3 is dedicated to account #3

Sheet 1 has the totals for the two accounts.
Sheet1!A corresponds to account number,
Sheet1!B corresponds to date
Sheet1!C corresponds to transaction


I want to fill data in Sheet1!B2 and C2 and it gets automatically copied in its corresponding collumns in Sheet2 (Sheet2!A and Sheet2!B)

Same for Sheet1!A3 and B3 and automatically copied into corresponding cells in Sheet 3.

I want the data to be filled in sheet 2 each time the file is saved on the condition that the date is changed from the previous date entry in Sheet2!A.If date not changed then I want to edit the entry in the corresponding date.

Same condition for copying data into sheet 3 , that the date changes from previous date entry in sheet3!A otherwise value is updated in corresponding date.

Example:
Sheet1
A B C
1 1/2/05 50
2 2/3/05 60



Sheet2(Account#1)
A B
1/2/05 50


Sheet3(Account#2)
A B
2/3/05 60

If i ,then, changed Sheet1 to be
Sheet1
A B C
1 1/2/05 40
2 2/4/05 80

Corresponding values in Sheet2, and 3)
Sheet2(Account#1)
A B
1/2/05 40--->value edited because date not changed


Sheet3(Account#2)
A B
2/3/05 60
2/4/05 80



Can you hlep me?

 

[acw]

Hi

I think the general logic will do what you want, but you will have to modify to incorporate into a workbook_save event. This has been written as a general module.

Sub bbb()
 shtarr = Array("sheet2", "sheet3")
 Sheets("sheet1").Select
 For Each ce In Sheets("sheet1").Range("a1:a" & Cells(Rows.Count, "A").End(xlUp).Row)
  findit = 0
  On Error Resume Next
  findit = Evaluate("=if(isna(Match(" & ce.Offset(0, 1).Address & "," & shtarr(ce.Value - 1) & "!a:a, 0)),0,Match(" & ce.Offset(0, 1).Address & "," & shtarr(ce.Value - 1) & "!a:a, 0))")
  On Error GoTo 0
  If findit > 0 Then
   Sheets(shtarr(ce.Value - 1)).Range("b1").Offset(ce.Value - 1).Value = ce.Offset(0, 2).Value
  Else
   nextrow = Sheets(shtarr(ce.Value - 1)).Cells(Rows.Count, "A").End(xlUp).Row + 1
   Sheets(shtarr(ce.Value - 1)).Range("a" & nextrow).Value = ce.Offset(0, 1).Value
   Sheets(shtarr(ce.Value - 1)).Range("b" & nextrow).Value = ce.Offset(0, 2).Value
  End If
 Next ce
End Sub

Tony

 

[Dalia123]

I got the runtime error #13:Type mismatch on line 13 which is

nextrow = Sheets(shtarr(ce.Value - 1)).Cells(Rows.Count, "A").End(xlUp).Row + 1

 

[Dalia123]

I got the runtime error #13:Type mismatch on line 13 which is

nextrow = Sheets(shtarr(ce.Value - 1)).Cells(Rows.Count, "A").End(xlUp).Row 1

 

[Dalia123]

Can you help me?

 

[acw]

HI

Can you post the code you have changed, and advise where you have placed the code.


Tony

 

[Dalia123]

I put this code in "ThisWorkbook"

Sub bbb()
shtarr = Array("sheet2", "sheet3")
Sheets("sheet1").Select
For Each ce In Sheets("sheet1").Range("a1:a" & Cells(Rows.Count, "A").End(xlUp).Row)
findit = 0
On Error Resume Next
findit = Evaluate("=if(isna(Match(" & ce.Offset(0, 1).Address & "," & shtarr(ce.Value - 1) & "!a:a, 0)),0,Match(" & ce.Offset(0, 1).Address & "," & shtarr(ce.Value - 1) & "!a:a, 0))")
On Error GoTo 0
If findit > 0 Then
Sheets(shtarr(ce.Value - 1)).Range("b1").Offset(ce.Value - 1).Value = ce.Offset(0, 2).Value
Else
nextrow = Sheets(shtarr(ce.Value - 1)).Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets(shtarr(ce.Value - 1)).Range("a" & nextrow).Value = ce.Offset(0, 1).Value
Sheets(shtarr(ce.Value - 1)).Range("b" & nextrow).Value = ce.Offset(0, 2).Value
End If
Next ce
End Sub


Now when I run this script I get the error 'Out of memory'