VBA Clean up

mrhonda

Board Regular
Joined
Feb 16, 2011
Messages
50
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

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
 

Some videos you may like

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.

Airfix9

Well-known Member
Joined
Sep 23, 2005
Messages
886
Try this:

Code:
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
    With Rows("6:6")
        .EntireRow.Insert
        .Font.Bold = False
    End With
    
    Range("A6").FormulaR1C1 = "=TODAY()"
    With Range("B6")
        If CBCustomer.Value = "Van Noorloos Casco Bouw BV" Then
            .FormulaR1C1 = "=CONCATENATE(""C-"",R1C3+1)"
        ElseIf CBCustomer.Value = "Fabistaal BV" Then
            .FormulaR1C1 = "=CONCATENATE(""F-"",R1C3+1)"
        ElseIf CBCustomer.Value = "Van Noorloos Waterjet Snijtechniek BV" Then
            .FormulaR1C1 = "=CONCATENATE(""W-"",R1C3+1)"
        End If
    End With
    Range("C6") = TextBox1.Value
    Range("D6") = CBName.Value
    Range("E6").Value = CDate(DateBox.Value)
    Range("F6").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").FormulaR1C1 = _
        "=INT((RC[-1]-WEEKDAY(RC[-1])-DATE(YEAR(RC[-1]+4-WEEKDAY(RC[-1])),1,4))/7)+2"
    Range("I6").FormulaR1C1 = "=IF(RC[-4]>R1C2,"""",SUM((R1C2-RC[-4])/(RC[-2]-RC[-4])))"
    
    Dim myCells As Range
    For Each myCells In Range("A6:B6")
        myCells.Value = myCells.Value
    Next
    
    Range("Z1").Value = rng1 + 1
    ActiveCell.Copy
    
    Range("C1").Value = Range("Z1").Value
    
    Range("Z1").ClearContents
    
    With Range("A6:I6")
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ThemeColor = 1
            .TintAndShade = -0.349986266670736
            .Weight = xlThin
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
    End With
    
    With Union(Range("A6"), Range("E6:I6"))
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    
    
    With Range("B6")
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlCenter
    End With
    
    With Range("C6:D6")
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
    End With
    Application.Goto Range("A1"), True
    Unload NewOrder
    Application.ScreenUpdating = True
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,108,960
Messages
5,525,913
Members
409,671
Latest member
nasseralateek

This Week's Hot Topics

Top