May 26 2022 02:48 AM
Although I posted the matter as given below on 20-05-2022 and no response yet from Respected "MICROSOFT TECH COMMUNITY TEAM MEMBERS", and hope I will get assist in this regards.
Hi Respected COMMUNITY TEAM MEMBERS, hope all of You are well. my subject is that, I have an Excel Workbook and I unable to access that Excel work book just as I want by using VBA Code. Actually I have a Work book containing THREE SPREADSHEET.The name of stated SPREADSHEET respectively 1) ITEM RECEIVED Sheet , 2) ITEM LIST Sheet, 3) SUPPLIER LIST Sheet. I want to Transfer schedule DATA after entering DATA in ITEM RECEIVED Sheet and by pressing existing SAVE BUTTON exist in ITEM RECEIVED Sheet in TWO other SpreadSheet named ITEM LIST Sheet, and SUPPLIER LIST Sheet at a time simultaneously from ITEM RECEIVED Sheet from which data would be transferred. I use CODE And I confirm that there is must be fatal mistake in the coding which I have used. again I want to say when if found ITEM CODE and ITEM NAME is already there in ITEM LIST Sheet and if the same thing is adopted again in nexttime in ITEM RECEIVED Sheet with different Invoice No then ITEM CODE and ITEM NAME will not be repeat in ITEM LIST Sheet, as per row wise. CODE as given below . May I get assist in this regards.
Sub SaveData()
Dim wsItemRecd As Worksheet
Dim wtSupplierList As Worksheet
Dim wtItemList As Worksheet
Dim s As Long
Dim t As Long
Dim r As Long
Application.ScreenUpdating = False
Set wsItemRecd = Worksheets("ITEM RECEIVED")
Set wtSupplierList = Worksheets("SUPPLIER LIST")
Set wtItemList = Worksheets("ITEM LIST")
' Copy Item Name and Item Quantity
For s = 1 To 4
' Find first empty row in columns A:M on SUPPLIER LIST Sheet
t = wtSupplierList.Range("E:L").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
wtSupplierList.Cells(t, 2 * s + 2).Value = wsItemRecd.Range("E" & s + 2).Value
wtSupplierList.Cells(t, 2 * s + 3).Value = wsItemRecd.Range("F" & s + 2).Value
wtSupplierList.Range("M" & t).Value = wsItemRecd.Range("X3").Value
Next s
'Copy Date
wtSupplierList.Range("B" & t).Value = wsItemRecd.Range("A3").Value
'Copy Invoice No
wtSupplierList.Range("C" & t).Value = wsItemRecd.Range("B3").Value
'Copy Company Name
wtSupplierList.Range("D" & t).Value = wsItemRecd.Range("C3").Value
' Copy Item Code and Item Name
For s = 1 To 4
' Find first empty row in columns A:C on ITEM LIST Sheet
t = wtItemList.Range("A:C").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
wtItemList.Cells(t, 2 * s + 2).Value = wsItemRecd.Range("D" & s + 2).Value
wtItemList.Cells(t, 2 * s + 3).Value = wsItemRecd.Range("E" & s + 2).Value
Next s
Application.ScreenUpdating = True
End Sub
Sheets Picture as given below which as I want
ITEM LIST Sheet
Sr. No | Item Code | Item Name | Sales Price | |
AB1 | ABCD |
SUPPLIER LIST Sheet
Sr. No | Date | Invoice No | Supplier Name | Item Name | Qty | Item Name | Qty | Item Name | Qty | Item Name | Qty | Invoice Value |
26-05-2022 | 1 | BANGUR | ABCD | 1 | EFGH | 3 | IJKL | 5 | MNOP | 7 | 103 |
ITEM RECEIVED Sheet
| ||||||||||||||||||||||||
DATE | INVOICE NO | SUPPLIER NAME | ITEM CODE | ITEM NAME | QTY | UNIT PRICE | ITEM CODE | ITEM NAME | QTY | UNIT PRICE | ITEM CODE | ITEM NAME | QTY | UNIT PRICE | ITEM CODE | ITEM NAME | QTY | UNIT PRICE | SUB TOTAL | TAX | VALUE INCL TAX | DISC | INVOICE VALUE | |
26-05-2022 | 1 | BANGUR | AB1 | ABCD | 1 | 2 | AB2 | EFGH | 3 | 4 | AB3 | IJKL | 5 | 6 | AB4 | MNOP | 7 | 8 | 100 | 5% | 105 | 2 | 103 | |
May 26 2022 05:59 AM
May 27 2022 05:12 AM
May 27 2022 05:35 AM
Jun 01 2022 11:41 PM
Respected@ mtarler Sir ,
I had posted my problem "DATA TRANSFERRING IN TWO EXCEL SHEET AT A TIME" by pressing SAVE BUTTON on 17-05-2022 using VBA CODE as given below.
Sub SaveData()
Dim ws As Worksheet
Dim wt As Worksheet
Dim wt As Worksheet
Dim s As Long
Dim t As Long
Dim r As Long
Application.ScreenUpdating = False
Set ws = Worksheets("ITEM RECEIVED")
Set wt = Worksheets("SUPPLIER LIST")
Set wt = Worksheets("ITEM LIST")
' Find first empty row in columns A:M on SUPPLIER LIST Sheet
t = wt.Range("A:J").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
' Copy Item Name and Item Quantity
For s = 1 To 4
wt.Cells(t, 2 * s + 2).Value = ws.Range("F" & s + 2).Value
wt.Cells(t, 2 * s + 3).Value = ws.Range("E" & s + 2).Value
wt.Range("M" & t).Value = ws.Range("X5").Value
Next s
'Copy Date
wt.Range("B" & t).Value = ws.Range("A5").Value
'Copy Invoice No
wt.Range("C" & t).Value = ws.Range("B5").Value
'Copy Company Name
wt.Range("D" & t).Value = ws.Range("C5").Value
' Find first empty row in columns A:C on ITEM LIST Sheet
t = wt.Range("A:C").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
' Copy Item Code and Item Name
For s = 1 To 4
wt.Cells(t, 2 * s + 2).Value = ws.Range("D" & s + 2).Value
wt.Cells(t, 2 * s + 3).Value = ws.Range("E" & s + 2).Value
Next s
Application.ScreenUpdating = True
End Sub
The Above stated code I have used for a Work book for transferring Data at a time in to Sheet2 and Sheet3 simultaneously from Sheet1 by pressing SAVE Button from which data would be transferred. And I confirm that there is must be fatal mistake in the coding which I have used. when if found SUPPLIER NAME and ITEM NAME is already there in Sheet2 and if the same
thing is adopted in next in Sheet1 with different Invoice No then ITEM CODE and ITEM NAME will not be repeat in Sheet2, as per row wise in Sheet1) ITEM RECEIVED Unfortunately, above
stated code not work properly. Is it possible for transferring schedule data in both sheet at a time by pressing SAVE BUTTON? May I get help? With regards.
on the same date I got VBA Code from our respected "COMMUNITY TEAM MEMBER " Mr. Subodh_Tiwari_sktneer Sir as below
Sub SaveData()
Dim wsItemRecd As Worksheet
Dim wsSupplier As Worksheet
Dim wsItemList As Worksheet
Dim s As Long
Dim t As Long
Dim r As Long
Application.ScreenUpdating = False
Set wsItemRecd = Worksheets("ITEM RECEIVED")
Set wsSupplier = Worksheets("SUPPLIER LIST")
Set wsItemList = Worksheets("ITEM LIST")
' Copy Item Name and Item Quantity
For s = 1 To 4
' Find first empty row in columns A:J on SUPPLIER LIST Sheet
t = wsSupplier.Range("A:J").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
wsSupplier.Cells(t, 2 * s + 2).Value = wsItemRecd.Range("F" & s + 2).Value
wsSupplier.Cells(t, 2 * s + 3).Value = wsItemRecd.Range("E" & s + 2).Value
wsSupplier.Range("M" & t).Value = wsItemRecd.Range("X5").Value
Next s
'Copy Date
wsSupplier.Range("B" & t).Value = wsItemRecd.Range("A5").Value
'Copy Invoice No
wsSupplier.Range("C" & t).Value = wsItemRecd.Range("B5").Value
'Copy Company Name
wsSupplier.Range("D" & t).Value = wsItemRecd.Range("C5").Value
' Copy Item Code and Item Name
For s = 1 To 4
' Find first empty row in columns A:C on ITEM LIST Sheet
t = wsItemList.Range("A:C").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
wsItemList.Cells(t, 2 * s + 2).Value = wsItemRecd.Range("D" & s + 2).Value
wsItemList.Cells(t, 2 * s + 3).Value = wsItemRecd.Range("E" & s + 2).Value
Next s
Application.ScreenUpdating = True
End Sub
i used the same above in my project but it not works properly. On 26-05-2022 I posted the same problem in caption "NO REPLY FOR MY PROBLEM" and ther is no incident of TWEAK/FIX.
ultimately i am now feeling that it is completely the matter of mother tongue. actually my mother tongue is BENALI , I live in BENGAL of INDIA and i understand that i cannot
explain my problem to YOU properly.i am presenting the sheet picture as whst i want.
Pic. ITEM LIST Sheet
Sr. No | Item Code | Item Name | Sales Price |
AB1 | ABCD | ||
AB2 | EFGH | ||
AB3 | IJKL | ||
AB4 | MNOP | ||
AB6 | QRST | ||
AB7 | UVWX | ||
if found same Item Code and same Item Name adopted in ITEM RECEIVED Sheet with different invoice no. then Item Code and Item Name not repeat in ITEM LIST SHEET |
Pic. SUPPLIER LIST Sheet
Sr. No | Date | Invoice No | Supplier Name | Item Name | Qty | Item Name | Qty | Item Name | Qty | Item Name | Qty | Invoice Value |
01-04-2020 | 1 | KOLKATA | ABCD | 1 | EFGH | 3 | IJKL | 5 | MNOP | 7 | 103 | |
02-04-2020 | 2 | MUMBAI | EFGH | 9 | IJKL | 11 | 105.1 | |||||
03-04-2020 | 3 | DELHI | ABCD | 4 | IJKL | 9 | MNOP | 14 | 180.7 | |||
04-04-2020 | 4 | CHENNAI | EFGH | 5 | MNOP | 19 | 178.6 | |||||
05-04-2020 | 5 | BANGALORE | ABCD | 1 | IJKL | 17 | 107.2 | |||||
18-06-2020 | 31 | PUNE | QRST | 11 | UVWX | 11 | 275.2 |
Pic. ITEM RECEIVED Sheet
| ||||||||||||||||||||||||
DATE | INVOICE NO | SUPPLIER NAME | ITEM CODE | ITEM NAME | QTY | UNIT PRICE | ITEM CODE | ITEM NAME | QTY | UNIT PRICE | ITEM CODE | ITEM NAME | QTY | UNIT PRICE | ITEM CODE | ITEM NAME | QTY | UNIT PRICE | SUB TOTAL | TAX | VALUE INCL TAX | DISC | INVOICE VALUE | |
01-04-2020 | 1 | KOLKATA | AB1 | ABCD | 1 | 2 | AB2 | EFGH | 3 | 4 | AB3 | IJKL | 5 | 6 | AB4 | MNOP | 7 | 8 | 100 | 5% | 105 | 2 | 103 | |
02-04-2020 | 2 | MUMBAI | AB2 | EFGH | 9 | 4 | AB3 | IJKL | 11 | 6 | 102 | 5% | 107.1 | 2 | 105.1 | |||||||||
03-04-2020 | 3 | DELHI | AB1 | ABCD | 4 | 2 | AB3 | IJKL | 9 | 6 | AB4 | MNOP | 14 | 8 | 174 | 5% | 182.7 | 2 | 180.7 | |||||
04-04-2020 | 4 | CHENNAI | AB2 | EFGH | 5 | 4 | AB4 | MNOP | 19 | 8 | 172 | 5% | 180.6 | 2 | 178.6 | |||||||||
05-04-2020 | 5 | BANGALORE | AB1 | ABCD | 1 | 2 | AB3 | IJKL | 17 | 6 | 104 | 5% | 109.2 | 2 | 107.2 | |||||||||
18-06-2020 | 31 | PUNE | AB6 | QRST | 11 | 10 | AB7 | UVWX | 11 | 14 | 264 | 5% | 277.2 | 2 | 275.2 |
Jun 09 2022 02:32 AM