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

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)
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 Question
How to pass variable between subs that are stored as array element through CreateObject("Scripting.Dictionary")
Replies
1
Views
523
Micron
M
C
  • Question Question
Copy and paste data through multiple workbooks
Replies
2
Views
507
CDaviess
C
G
  • Question Question
Creating a Word Doc using Excel VBA
Replies
2
Views
328
rikvny02
R
Rip1971
  • Solved
Copy code does not copy
Replies
5
Views
502
offthelip
O
T
  • Question Question
MrExcel Code to loop through Slicers not working
Replies
0
Views
562
TopCatz
T

Forum statistics

Threads
1,224,823
Messages
6,181,177
Members
453,021
Latest member
Justyna P

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