Code vereenvoucigen

[Segers]

Onderstaande code gaat rij per rij af, tot rij 20
Enkel, als er een PART is als strSOLD, worden er twee rijen ingevoegd.

Iemand enig idee hoe ik code kan vereenvoudigen?

Ik wou het bestand uploaden, maar zelfs in ZIP-format nog steeds te groot (154 kb)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

 Dim strSale As String
 Dim dblCarats As Double
 Dim dblA1 As Double
 Dim dblTot1 As Double
 Dim dblF1 As Double
 Dim dblTot2 As Double

 Application.EnableEvents = False

 Static oldRange As Range
 If Not oldRange Is Nothing Then
    If oldRange.Address = "$AA$2" Then
        strSale = InputBox("Part or Complete?")
        UCase (strSale)
        If strSale = "PART" Then
            Worksheets("Sheet1").Rows(2).Select
            'Insert row below active cell
            ActiveCell.Offset(1).EntireRow.Insert
            Worksheets("Sheet1").Rows(2).Select
            'Insert row below active cell
            ActiveCell.Offset(1).EntireRow.Insert
            Range("A2:Y2").Font.Color = vbGreen
            Range("A3:Y3").Font.Color = vbRed
            Range("A4:Y4").Font.Color = vbBlack
            Range("B3").Value = Range("B2").Value
            Range("B4").Value = Range("B2").Value
            Range("C3").Value = Range("C2").Value & "A"
            Range("C4").Value = Range("C2").Value & "B"
            Range("D3").Value = Range("B3").Value & "-" & Range("C3").Value
            Range("D4").Value = Range("B4").Value & "-" & Range("C4").Value
            strCarats = InputBox("How many carats has been sold?")
            strF1 = InputBox("What was the final price per Carat?")
            Range("L3").Value = strCarats
            Range("O3").Value = strF1
            Range("P3").Value = strF1 * strCarats
            Range("L4").Value = Range("L2").Value - Range("L3").Value
            Range("M4").Value = Range("M2").Value
            Range("N4").Value = Range("M2").Value * Range("L4").Value
        ElseIf strSale = "COMPLETE" Then
            Range("A2:Y2").Font.Color = vbRed
            Range("M2:P2").Locked = True
        Else
            strSale = InputBox("Part or Complete?")
        End If
    ElseIf oldRange.Address = "$AA$3" And Range("A3").Value <> "" Then
        strSale = InputBox("Part or Complete?")
        UCase (strSale)
        If strSale = "PART" Then
            Worksheets("Sheet1").Rows(3).Select
            'Insert row below active cell
            ActiveCell.Offset(1).EntireRow.Insert
            Worksheets("Sheet1").Rows(3).Select
            'Insert row below active cell
            ActiveCell.Offset(1).EntireRow.Insert
            Range("A3:Y3").Font.Color = vbGreen
            Range("A4:Y4").Font.Color = vbRed
            Range("A5:Y5").Font.Color = vbBlack
            Range("B4").Value = Range("B3").Value
            Range("B5").Value = Range("B3").Value
            Range("C4").Value = Range("C3").Value & "A"
            Range("C5").Value = Range("C3").Value & "B"
            Range("D4").Value = Range("B4").Value & "-" & Range("C4").Value
            Range("D5").Value = Range("B5").Value & "-" & Range("C5").Value
            strCarats = InputBox("How many carats has been sold?")
            strF1 = InputBox("What was the final price per Carat?")
            Range("L4").Value = strCarats
            Range("O4").Value = strF1
            Range("P4").Value = strF1 * strCarats
            Range("L5").Value = Range("L3").Value - Range("L4").Value
            Range("M5").Value = Range("M3").Value
            Range("N5").Value = Range("M3").Value * Range("L5").Value
        ElseIf strSale = "COMPLETE" Then
            Range("A3:Y3").Font.Color = vbRed
            Range("M3:P3").Locked = True
        Else
            strSale = InputBox("Part or Complete?")
        End If
    End If
 End If
 
 Set oldRange = Target
 
 Application.EnableEvents = True
 
 End Sub

 

[Warme bakkertje]

Nogal logisch als je 2x de instructie Insert na elkaar gebruikt.
Upload een bestand met enkel het betreffende tabblad.