Hi guy's
I made a VBA code with the help of this forum, which works great thanks.
There is a lot of cell selecting going on etc.
So if it's not much to ask I'd like the experds here to through a glimps at it and maybe shorten it a bit?
thanks in advance
I made a VBA code with the help of this forum, which works great thanks.
There is a lot of cell selecting going on etc.
So if it's not much to ask I'd like the experds here to through a glimps at it and maybe shorten it a bit?
thanks in advance
Code:
Private Sub Order_Click()
Private Sub Order_Click()
Dim rng1 As Range
Set rng1 = Range("C1")
If CBCustomer = "" Then
MsgBox ("Selecteer de BV waarvoor je een klant wil aanmaken"), vbCritical, "Fout!"
Exit Sub
End If
If CBName = "" Then
MsgBox ("Selecteer een klant"), vbCritical, "Fout!"
Exit Sub
End If
If TextBox1 = "" Then
MsgBox ("Opdracht omschrijving invoeren"), vbCritical, "Fout!"
Exit Sub
End If
If DateBox = "" Then
MsgBox ("Start datum invoeren"), vbCritical, "Fout!"
Exit Sub
End If
If DateBox2 = "" Then
MsgBox ("Eind datum invoeren"), vbCritical, "Fout!"
Exit Sub
End If
Application.ScreenUpdating = False
Rows("6:6").Select
Selection.Insert Shift:=xlDown
Selection.Font.Bold = False
Range("A6").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("B6").Select
If CBCustomer.Value = "Van Noorloos Casco Bouw BV" Then ActiveCell.FormulaR1C1 = "=CONCATENATE(""C-"",R1C3+1)"
If CBCustomer.Value = "Fabistaal BV" Then ActiveCell.FormulaR1C1 = "=CONCATENATE(""F-"",R1C3+1)"
If CBCustomer.Value = "Van Noorloos Waterjet Snijtechniek BV" Then ActiveCell.FormulaR1C1 = "=CONCATENATE(""W-"",R1C3+1)"
Range("C6") = TextBox1.Value
Range("D6") = CBName.Value
Range("E6").Value = CDate(DateBox.Value)
Range("F6").Select
ActiveCell.FormulaR1C1 = _
"=INT((RC[-1]-WEEKDAY(RC[-1])-DATE(YEAR(RC[-1]+4-WEEKDAY(RC[-1])),1,4))/7)+2"
Range("G6").Value = CDate(DateBox2.Value)
Range("H6").Select
ActiveCell.FormulaR1C1 = _
"=INT((RC[-1]-WEEKDAY(RC[-1])-DATE(YEAR(RC[-1]+4-WEEKDAY(RC[-1])),1,4))/7)+2"
Range("I6").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-4]>R1C2,"""",SUM((R1C2-RC[-4])/(RC[-2]-RC[-4])))"
Range("A6:B6").Copy
Range("A6").Activate
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("C6").Select
Range("Z1").Activate
ActiveCell.Value = rng1 + 1
ActiveCell.Copy
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("Z1").ClearContents
Range("A6:I6").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.349986266670736
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
Range("A6").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Range("B6").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
End With
Range("C6").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
End With
Range("D6").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
End With
Range("E6").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Range("F6").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Range("G6").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Range("H6").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Range("I6").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Range("A1").Select
Unload NewOrder
Application.ScreenUpdating = True
End Sub