Simple spreadsheet for overseeing incoming deliveries

nProzac · Jun 9th 2020

Hi guys!

First of all - I have very limited knowledge of VBA dating all the way back to high school, not to mention lack of experience nor neat coding practices.
Nonetheless, by some miracle or maybe God's sign, I was given a chance to bounce from the bottom of my life and actually got a job I'm good at!

My first task was making aforementioned spreadsheet (the previous one got obliterated by freedom of changes by end users and beyond repair without previous employee).

After templating it, bit by bit i kept adding various lines of simple code - first to get a grasp, then understand and eventually meaningfully implement.

Many of these small QOL improvements use absurd ways to achieve the end result, reason being me not wanting to use certain expressions or methods that seemed a bit too much for my error-prone ways.

Obviously my first attempt have been an amalgamation of bugs arising from adapting foreign lines of code into my project. Slowly though, I kept organising and tidying up those, and... here we are. Since COVID pandemic that simple shared filed has been helping our small company in fixing communication issues or other convoluted procedures, without the need to bother IT/spend time developing new ones in those dire times. Sadly, this made me some heuristic instant-remedy-problem-solver for my office...

I love this job, this workplace, and the fact that my life is back on track for the first time ever. I will do everything to keep it this way, even if it means falsely sticking to that image until I fit, where I shouldn't be in the first place.

Many thanks guys in advance, and sorry for long intro. I'm uploading my little monster translated.

The idea is very simple, but just in case:

- Employee inserts order ID and product we were lacking, quanity and minimum price (C-F)
- Next fields are to be completed by another employee after getting ahold of needed product (G-L)

- The rest is done by people actually handling the goods (stuff gets there, stuff gets processed, stuff gets sent to final buyer M-O), rest is more or less obsolete

Things to consider:

- No tables

- Has to be idiot-proof

- Pasting can be done in many ways, many of them interfere with/bypass certain events. As such I've at least tried to direct the user by disabling CTRL+V (it gives tip to paste values only)

- It has to prevent writing into cell, that has data in it already. Exception to this are checkmarks

- Users can delete rows after being notified, and entire rows only

- Since everything is protected and cannot allow hiding/unhiding/sorting, this is done by adding one filter and hidden index number (so nobody can sort it his way and fkp it for everone else)

Currently the only thing causing issue is deleting rows, I'm sure you can see how potentially disastrous :D. Next thing I'm trying to incorporate into it is automatic checking of UPS delivery status, but maybe few tutorials later given my so-so success.

Any tips are very much welcome, I'm in dept for your time anyhow guys.

Code

Dim oldValue As Variant
Dim answer As Integer
Dim xsend As Range
Dim xzam As Range
Dim xkaro As Range
Dim karo2 As Range
Private Sub Worksheet_SelectionChange(ByVal target As Range)
If target.Count < 4 Then oldValue = target.Value
If target.Columns.Count > 100 Then answer = MsgBox("Wyjebać?", vbYesNo + vbQuestion, "Uwaga wyjebka")
If answer = vbYes Then
Application.EnableEvents = False
oldValue = Null
target.EntireRow.Delete
Application.EnableEvents = True
Cancel = True
Else: Cancel = True
End If
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean)
If target.Value = "" And Not Intersect(target, Range("I2:I200")) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
target.Value = ChrW(&H2713)
Cancel = True
Application.EnableEvents = True
ElseIf target.Value = "" And Not Intersect(target, Range("M2:O200")) Is Nothing Then
Application.ScreenUpdating = False
target.Value = ChrW(&H2713)
Cancel = True
ElseIf target.Value = ChrW(&H2713) Then
Application.ScreenUpdating = False
Application.EnableEvents = False
target.ClearContents
Cancel = True
Application.EnableEvents = True
Else: Cancel = True
End If
Application.ScreenUpdating = True
End Sub
Public Sub Worksheet_Change(ByVal target As Range)
On Error Resume Next
Set xsend = Intersect(Range("N2:N200"), target)
Set xkaro = Intersect(Range("J2:J200"), target)
Set xkaro2 = Intersect(Range("K2:K200"), target)
Set xzam = Intersect(Range("D2:D200"), target)
If Not xzam Is Nothing Then
If oldValue <> "" Then
Application.EnableEvents = False
target.Offset(0, 16).Value = Application.UserName
Application.EnableEvents = True
End If
ElseIf Not xsend Is Nothing Then
If target.Value <> "" Then
Call Powiadom(target)
End If
ElseIf Not xkaro Is Nothing Then
If target.Offset(0, -1).Value = ChrW(&H2713) Then
Call Powiadom2(target)
End If
' ElseIf Not xkaro2 Is Nothing Then
' If target.Offset(0, 1).Value = "UPS" Then
' Call GetUPSDeliveryDate(target)
' End If
ElseIf oldValue <> "" Then
Application.EnableEvents = False
On Error Resume Next
Application.Undo
Application.EnableEvents = True
End If
End Sub
Sub Powiadom(target As Range)
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Przyjęto następujące towary:" & vbNewLine & vbNewLine & _
target.Offset(0, -10) & " - " & target.Offset(0, -9) & "szt." & vbNewLine & _
""
On Error Resume Next
With xOutMail
.To = "[email protected]; [email protected]; [email protected]"
.CC = ""
.BCC = ""
.Subject = "Zamówienie " & target.Offset(0, -11)
.body = xMailBody
.Display 'albo .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Sub Powiadom2(target As Range)
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = target.Offset(0, -2) & vbNewLine & _
"IAI: " & target.Offset(0, -7) & " - " & target.Offset(0, -6) & _
""
On Error Resume Next
With xOutMail
.To = "[email protected]"
.CC = ""
.BCC = ""
.Subject = "Blind do " & target.Offset(0, -7)
.body = xMailBody
.Importance = 2
.Display 'albo .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

Display More

Code

Private Sub Workbook_Open()
With Application
.Iteration = True
.MaxIterations = 1
.MaxChange = 0.0001
End With
Dim ws As Worksheet
Application.ScreenUpdating = False
Call odblokuj
Call zablokuj
On Error Resume Next
Worksheets("Sheet4").Activate
Application.ScreenUpdating = True
End Sub
Public Sub Workbook_Activate()
Application.OnKey "^v", "wklej"
End Sub
Public Sub Workbook_Deactivate()
Application.OnKey "^v"
End Sub

Display More

Code

Sub wklej()
MsgBox ("Prawy przycisk myszy -> Wklej wartości")
End Sub
Sub zablokuj()
' zablokuj Makro
' Zablokuj arkusz
'
' Klawisz skrótu: Ctrl+l
'
ActiveSheet.Protect "3363", UserInterfaceOnly:=True, DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
Application.EnableEvents = True
End Sub
Sub odblokuj()
'
' odblokuj Makro
'
' Klawisz skrótu: Ctrl+u
'
ActiveSheet.Unprotect "3363"
Application.EnableEvents = False
End Sub

Display More

Password: 3363

gerryjam · Jun 16th 2020

I'm not able to open a password protected spreadsheet. if you need to delete a specific row you can use Rows(index).EntireRow.Delete; where index = the row (number) you want to delete. For example to delete Row 3; Rows(3).EntireRow.Delete

Share