Values e automatically filled in a different sheet

Dalia123

New Member
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?

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},\$Z\$1:\$Z\$99,\$Y\$1:\$Y\$99),2,False) to lookup Y values to left of Z values.

acw

MrExcel MVP
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.

Code:
``````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

New Member
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

New Member
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

Can you help me?

acw

MrExcel MVP
HI

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

Tony

Dalia123

New Member
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'

Replies
9
Views
106
Replies
14
Views
166
Replies
9
Views
198
Replies
1
Views
80
Replies
1
Views
44

1,118,530
Messages
5,572,670
Members
412,481
Latest member
nhantam