Hi Experts,
With the following VBA code Document number not appearing in Tab Purchase D12 automatically from AA1 while putting the Brand name in E12:E30, please fix the code.
Private Sub Worksheet_change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Intersect(Target, Range("E12:E35")) Is Nothing Then Exit Sub
Dim fnd As Range
If Range("F9") = "From the price list" Then
Set fnd = Range("O12:O35").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not fnd Is Nothing Then
Target.Offset(, 5) = fnd.Offset(, 1)
End If
End If
End Sub
Private Sub Worksheet_Salesroll(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Intersect(Target, Range("E:E")) Is Nothing Then Exit Sub
Target.Offset(, -1) = Range("AA1")
Range("AA1") = Range("AA1") + 1
End Sub
Purchase
Database
AP
Module
'Purchase Module
Sub SaveNewDataPurchaseReel()
Application.ScreenUpdating = True
Dim LastRow As Long, brand As Range
Dim abcWS As Worksheet, srcWS As Worksheet, desWS As Worksheet
Dim cartage As Boolean
Set srcWS = Sheets("Purchase Reel")
Set desWS = Sheets("Database")
Set abcWS = Sheets("AP")
cartage = True
With srcWS
For Each brand In .Range("E12", .Range("E" & .Rows.Count).End(xlUp))
LastRow = desWS.Range("E" & .Rows.Count).End(xlUp).Row + 1
desWS.Range("A" & LastRow).Resize(, 1).Value = Array(.Range("D12"))
desWS.Range("B" & LastRow).Resize(, 2).Value = Array(.Range("O1"), .Range("N1"))
desWS.Range("D" & LastRow).Resize(, 3).Value = Array(.Range("F7"), .Range("J7"), .Range("J9"))
desWS.Range("G" & LastRow).Value = .Range("E" & brand.Row)
desWS.Range("H" & LastRow).Resize(, 6).Value = .Range("G" & brand.Row).Resize(, 6).Value
If cartage Then
desWS.Range("N" & LastRow).Resize(, 5).Value = Array(.Range("L37"), .Range("I37"), .Range("I38"), Application.UserName, [Text(Now(), "DD-MM-YYYY HH:MM:SS")])
Else
desWS.Range("O" & LastRow).Resize(, 4).Value = Array(.Range("I37"), .Range("I38"), Application.UserName, [Text(Now(), "DD-MM-YYYY HH:MM:SS")])
End If
cartage = False
desWS.Range("S" & LastRow).Resize(, 1).Value = Array(.Range("F9"))
desWS.Range("T" & LastRow).Resize(, 1).Value = Array(.Range("H36"))
desWS.Range("U" & LastRow).Resize(, 1).Value = Array(.Range("J5"))
desWS.Range("V" & LastRow).Resize(, 1).Value = Array(.Range("F5"))
Next brand
LastRow = abcWS.Range("E" & .Rows.Count).End(xlUp).Row + 1
abcWS.Range("A" & LastRow).Resize(, 1).Value = Array(.Range("D12"))
abcWS.Range("B" & LastRow).Resize(, 2).Value = Array(.Range("O1"), .Range("N1"))
abcWS.Range("D" & LastRow).Resize(, 3).Value = Array(.Range("F7"), .Range("J7"), .Range("J9"))
abcWS.Range("G" & LastRow).Resize(, 7).Value = Array(.Range("L36"), .Range("L37"), .Range("L38"), .Range("I37"), .Range("I38"), Application.UserName, [Text(Now(), "DD-MM-YYYY HH:MM:SS")])
abcWS.Range("N" & LastRow).Resize(, 1).Value = Array(.Range("H36"))
abcWS.Range("O" & LastRow).Resize(, 1).Value = Array(.Range("J5"))
abcWS.Range("P" & LastRow).Resize(, 1).Value = Array(.Range("F5"))
End With
Call ResetPurchaseReel
Application.ScreenUpdating = True
End Sub
Sub ResetPurchaseReel()
Dim srcWS As Worksheet
Set srcWS = Sheets("Purchase Reel")
With srcWS
.Range("F5,F7,F9,J7,J9").Interior.Color = xlNone
.Range("F5,F7,F9,J7,J9").Value = ""
.Range("D12:K35").Interior.Color = xlNone
.Range("D12:K35").Value = ""
.Range("I37:I38,L37,H36").Interior.Color = xlNone
.Range("I37:I38,L37,H36").Value = ""
End With
End Sub
With the following VBA code Document number not appearing in Tab Purchase D12 automatically from AA1 while putting the Brand name in E12:E30, please fix the code.
Private Sub Worksheet_change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Intersect(Target, Range("E12:E35")) Is Nothing Then Exit Sub
Dim fnd As Range
If Range("F9") = "From the price list" Then
Set fnd = Range("O12:O35").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not fnd Is Nothing Then
Target.Offset(, 5) = fnd.Offset(, 1)
End If
End If
End Sub
Private Sub Worksheet_Salesroll(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Intersect(Target, Range("E:E")) Is Nothing Then Exit Sub
Target.Offset(, -1) = Range("AA1")
Range("AA1") = Range("AA1") + 1
End Sub
Purchase
Test 3.xlsm | |||||||||||||||||||||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | W | X | Y | Z | AA | |||
1 | Purchase | PU | 5001 | ||||||||||||||||||||||||||
2 | Purchase Reel Data Entry Form | ||||||||||||||||||||||||||||
3 | |||||||||||||||||||||||||||||
4 | |||||||||||||||||||||||||||||
5 | Location | Factory No.5 | Product | Reel | |||||||||||||||||||||||||
7 | Supplier Name | Supplier No.18 | Invoice/Bill No. | 1009 | |||||||||||||||||||||||||
9 | Rate selection | From the price list | Invoice Date | 02/02/2022 | |||||||||||||||||||||||||
10 | |||||||||||||||||||||||||||||
11 | Document No. | Brand | Gram | Weight | Size | Quantity | Rate | Amount | |||||||||||||||||||||
12 | Orange | 101 | 750 | 25 | 100 | 52 | 3,900,000 | Orange | 52 | ||||||||||||||||||||
13 | Grapes | 108 | 700 | 27 | 200 | 53 | 7,420,000 | Grapes | 53 | ||||||||||||||||||||
14 | - | 0 | 54 | ||||||||||||||||||||||||||
15 | - | 0 | 55 | ||||||||||||||||||||||||||
16 | - | 0 | 56 | ||||||||||||||||||||||||||
17 | - | 0 | 57 | ||||||||||||||||||||||||||
18 | - | 0 | 58 | ||||||||||||||||||||||||||
19 | - | 0 | 59 | ||||||||||||||||||||||||||
20 | - | 0 | 60 | ||||||||||||||||||||||||||
21 | - | 0 | 61 | ||||||||||||||||||||||||||
22 | - | 0 | 62 | ||||||||||||||||||||||||||
23 | - | 0 | 63 | ||||||||||||||||||||||||||
24 | - | 0 | 64 | ||||||||||||||||||||||||||
25 | - | 0 | 65 | ||||||||||||||||||||||||||
26 | - | 0 | 66 | ||||||||||||||||||||||||||
27 | - | 0 | 67 | ||||||||||||||||||||||||||
28 | - | 0 | 68 | ||||||||||||||||||||||||||
29 | - | 0 | 69 | ||||||||||||||||||||||||||
30 | - | 0 | 70 | ||||||||||||||||||||||||||
31 | - | 0 | 71 | ||||||||||||||||||||||||||
32 | - | 0 | 72 | ||||||||||||||||||||||||||
33 | - | 0 | 73 | ||||||||||||||||||||||||||
34 | - | 0 | 74 | ||||||||||||||||||||||||||
35 | - | 0 | 75 | ||||||||||||||||||||||||||
36 | Remarks | Serial number no appearing automatically | Subtotal | 11,320,000 | |||||||||||||||||||||||||
37 | Vehicle No. | JX7000 | Cartage | 500,000 | |||||||||||||||||||||||||
38 | Driver Name | Driver No.14 | Total | 11,820,000 | |||||||||||||||||||||||||
39 | |||||||||||||||||||||||||||||
40 | |||||||||||||||||||||||||||||
41 | |||||||||||||||||||||||||||||
Purchase Reel |
Cell Formulas | ||
---|---|---|
Range | Formula | |
O12:O35 | O12 | =+E12 |
L12:L35 | L12 | =IFERROR(+J12*K12*H12,"") |
L36 | L36 | =SUM(L12:L35) |
L38 | L38 | =+L36+L37 |
Cells with Data Validation | ||
---|---|---|
Cell | Allow | Criteria |
F9:G9 | List | From the price list, Manual |
Database
Test 3.xlsm | ||||||||||||||||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | |||
1 | Document No. | Document type | Transaction | Supplier/Customer Name | Invoice No. | Invoice Date | Brand | Gram | Weight | Size | Quantity | Rate | Amount | Cartage | Vehicle No. | Driver Name | User ID | Transaction Date | Rate Selection | Remarks | Product | Location To | ||
2 | PU | Purchase | Supplier No.1 | 1005 | 1/1/2022 | Apple | 100 | 740 | 22 | 250 | 52 | 9,620,000 | 250,000 | JX8070 | Driver No.1 | ZESSA-Click | 29-04-2022 13:55:57 | From the price list | Serial number is appearing automatically | Reel | Factory 1 | |||
3 | PU | Purchase | Supplier No.1 | 1005 | 1/1/2022 | Banana | 105 | 750 | 23 | 300 | 53 | 11,925,000 | JX8070 | Driver No.1 | ZESSA-Click | 29-04-2022 13:55:57 | From the price list | Serial number is appearing automatically | Reel | Factory 1 | ||||
Database |
AP
Test 3.xlsm | ||||||||||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | |||
1 | Document No. | Document type | Transaction | Supplier/Customer Name | Invoice No. | Invoice Date | Subtotal | Cartage | Amount | Vehicle No. | Driver Name | User ID | Transaction Date | Remarks | Product | Location To | ||
2 | PU | Purchase | Supplier No.1 | 1005 | 1/1/2022 | 21,545,000 | 250,000 | 21,795,000 | JX8070 | Driver No.1 | ZESSA-Click | 29-04-2022 13:55:57 | Serial number is appearing automatically | Reel | Factory 1 | |||
AP |
Module
'Purchase Module
Sub SaveNewDataPurchaseReel()
Application.ScreenUpdating = True
Dim LastRow As Long, brand As Range
Dim abcWS As Worksheet, srcWS As Worksheet, desWS As Worksheet
Dim cartage As Boolean
Set srcWS = Sheets("Purchase Reel")
Set desWS = Sheets("Database")
Set abcWS = Sheets("AP")
cartage = True
With srcWS
For Each brand In .Range("E12", .Range("E" & .Rows.Count).End(xlUp))
LastRow = desWS.Range("E" & .Rows.Count).End(xlUp).Row + 1
desWS.Range("A" & LastRow).Resize(, 1).Value = Array(.Range("D12"))
desWS.Range("B" & LastRow).Resize(, 2).Value = Array(.Range("O1"), .Range("N1"))
desWS.Range("D" & LastRow).Resize(, 3).Value = Array(.Range("F7"), .Range("J7"), .Range("J9"))
desWS.Range("G" & LastRow).Value = .Range("E" & brand.Row)
desWS.Range("H" & LastRow).Resize(, 6).Value = .Range("G" & brand.Row).Resize(, 6).Value
If cartage Then
desWS.Range("N" & LastRow).Resize(, 5).Value = Array(.Range("L37"), .Range("I37"), .Range("I38"), Application.UserName, [Text(Now(), "DD-MM-YYYY HH:MM:SS")])
Else
desWS.Range("O" & LastRow).Resize(, 4).Value = Array(.Range("I37"), .Range("I38"), Application.UserName, [Text(Now(), "DD-MM-YYYY HH:MM:SS")])
End If
cartage = False
desWS.Range("S" & LastRow).Resize(, 1).Value = Array(.Range("F9"))
desWS.Range("T" & LastRow).Resize(, 1).Value = Array(.Range("H36"))
desWS.Range("U" & LastRow).Resize(, 1).Value = Array(.Range("J5"))
desWS.Range("V" & LastRow).Resize(, 1).Value = Array(.Range("F5"))
Next brand
LastRow = abcWS.Range("E" & .Rows.Count).End(xlUp).Row + 1
abcWS.Range("A" & LastRow).Resize(, 1).Value = Array(.Range("D12"))
abcWS.Range("B" & LastRow).Resize(, 2).Value = Array(.Range("O1"), .Range("N1"))
abcWS.Range("D" & LastRow).Resize(, 3).Value = Array(.Range("F7"), .Range("J7"), .Range("J9"))
abcWS.Range("G" & LastRow).Resize(, 7).Value = Array(.Range("L36"), .Range("L37"), .Range("L38"), .Range("I37"), .Range("I38"), Application.UserName, [Text(Now(), "DD-MM-YYYY HH:MM:SS")])
abcWS.Range("N" & LastRow).Resize(, 1).Value = Array(.Range("H36"))
abcWS.Range("O" & LastRow).Resize(, 1).Value = Array(.Range("J5"))
abcWS.Range("P" & LastRow).Resize(, 1).Value = Array(.Range("F5"))
End With
Call ResetPurchaseReel
Application.ScreenUpdating = True
End Sub
Sub ResetPurchaseReel()
Dim srcWS As Worksheet
Set srcWS = Sheets("Purchase Reel")
With srcWS
.Range("F5,F7,F9,J7,J9").Interior.Color = xlNone
.Range("F5,F7,F9,J7,J9").Value = ""
.Range("D12:K35").Interior.Color = xlNone
.Range("D12:K35").Value = ""
.Range("I37:I38,L37,H36").Interior.Color = xlNone
.Range("I37:I38,L37,H36").Value = ""
End With
End Sub