Document number not appearing through VBA code

Z

Zubair

Active Member
Joined
Jul 4, 2009
Messages
304
Office Version
  1. 2016
Platform
  1. Windows
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
Test 3.xlsm
ABCDEFGHIJKLMNOPQRSTUVWXYZAA
1PurchasePU5001
2Purchase Reel Data Entry Form
3
4
5LocationFactory No.5ProductReel
7Supplier NameSupplier No.18Invoice/Bill No.1009
9Rate selectionFrom the price listInvoice Date02/02/2022
10
11Document No.BrandGramWeightSizeQuantityRate Amount
12Orange10175025100523,900,000Orange52
13Grapes10870027200537,420,000Grapes53
14-054
15-055
16-056
17-057
18-058
19-059
20-060
21-061
22-062
23-063
24-064
25-065
26-066
27-067
28-068
29-069
30-070
31-071
32-072
33-073
34-074
35-075
36RemarksSerial number no appearing automaticallySubtotal11,320,000
37Vehicle No.JX7000Cartage500,000
38Driver NameDriver No.14Total11,820,000
39
40
41
Purchase Reel
Cell Formulas
RangeFormula
O12:O35O12=+E12
L12:L35L12=IFERROR(+J12*K12*H12,"")
L36L36=SUM(L12:L35)
L38L38=+L36+L37
Cells with Data Validation
CellAllowCriteria
F9:G9ListFrom the price list, Manual


Database
Test 3.xlsm
ABCDEFGHIJKLMNOPQRSTUV
1Document No.Document typeTransactionSupplier/Customer NameInvoice No.Invoice DateBrandGramWeightSizeQuantityRate Amount Cartage Vehicle No.Driver NameUser IDTransaction DateRate SelectionRemarksProductLocation To
2PUPurchaseSupplier No.110051/1/2022Apple10074022250529,620,000250,000 JX8070 Driver No.1ZESSA-Click29-04-2022 13:55:57From the price listSerial number is appearing automaticallyReelFactory 1
3PUPurchaseSupplier No.110051/1/2022Banana105750233005311,925,000 JX8070 Driver No.1ZESSA-Click29-04-2022 13:55:57From the price listSerial number is appearing automaticallyReelFactory 1
Database


AP
Test 3.xlsm
ABCDEFGHIJKLMNOP
1Document No.Document typeTransactionSupplier/Customer NameInvoice No.Invoice Date Subtotal Cartage Amount Vehicle No.Driver NameUser ID Transaction Date Remarks ProductLocation To
2PUPurchaseSupplier No.110051/1/202221,545,000250,00021,795,000JX8070Driver No.1ZESSA-Click 29-04-2022 13:55:57 Serial number is appearing automatically ReelFactory 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
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Sort by date Sort by votes
I'am not sure that i understanded your problem right.
But let's try.

1. I don't see where or how you call "Private Sub Worksheet Sales roll"
- Only a Sub named Worksheet_change can start automatically from a worksheet change.
2. Each added Brand increments the document number but writes it only when row 12 change. (I think you meant it that way?)



VBA 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)
Call Worksheet_Salesroll(Target) ' Added to launch Worksheet_Salesroll
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
 
Upvote 0
Solution
Tupe77 said:
I'am not sure that i understanded your problem right.
But let's try.

1. I don't see where or how you call "Private Sub Worksheet Sales roll"
- Only a Sub named Worksheet_change can start automatically from a worksheet change.
2. Each added Brand increments the document number but writes it only when row 12 change. (I think you meant it that way?)



VBA 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)
Call Worksheet_Salesroll(Target) ' Added to launch Worksheet_Salesroll
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
Click to expand...
Hi Tupe77 - thanks for your suggestion

The following addition resolved my problem.

Call Worksheet_Salesroll(Target) ' Added to launch Worksheet_Salesroll
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question
How to pass variable between subs that are stored as array element through CreateObject("Scripting.Dictionary")
Replies
1
Views
95
Micron
M
Rip1971
  • Solved
Copy code does not copy
Replies
5
Views
357
offthelip
O
C
  • Question
Copy and paste data through multiple workbooks
Replies
2
Views
218
CDaviess
C
T
  • Question
MrExcel Code to loop through Slicers not working
Replies
0
Views
260
TopCatz
T
S
  • Question
VBA to copy data from one worksheet to another (only specific columns)
Replies
2
Views
796
SpireiteSteve
S

Forum statistics

Threads
1,215,463
Messages
6,124,965
Members
449,201
Latest member
Jamil ahmed

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top