locked
compile error: end if without block if RRS feed

  • Question

  • This is module files

    Option Explicit

    Sub Additem()
    Dim ItemRow As Long, AvailRow As Long
    With Sheet1
        If .Range("B5").Value = Empty Then Exit Sub
        On Error Resume Next
        .Shapes("itempic").Delete
        On Error GoTo 0
        ItemRow = .Range("B5").Value 'item row
        AvailRow = .Range("K999").End(xlUp).Row + 1 'firs avail row
        .Range("B6").Value = AvailRow 'Set Receipt Row
        .Range("E3").Value = Sheet2.Range("B" & ItemRow).Value 'Item Name
        .Range("F6").Value = Sheet2.Range("D" & ItemRow).Value 'Item Price
        .Range("F8").Value = 1 'Default Item Qty To 1

        'Add Item Detail to receipt
        .Range("K" & AvailRow).Value = .Range("E3").Value 'Item Name
        .Range("L" & AvailRow).Value = .Range("F8").Value 'Item Qty
        .Range("M" & AvailRow).Value = .Range("f6").Value 'Item Price
        .Range("N" & AvailRow).Value = "=L" & AvailRow & "*M" & AvailRow 'Total Price formula


        'On Error Resume Next
        If Dir(Sheet2.Range("E" & ItemRow).Value, vbDirectory) <> "" Then
            With .Pictures.Insert(Sheet2.Range("E" & ItemRow).Value)
             With .ShapeRange
              .LockAspectRatio = msoTrue
              .Height = 45
              .Name = "ItemPic"
            End With
           End With
           With .Shapes("ItemPic")
           .Left = Sheet1.Range("D6").Left
           .Top = Sheet1.Range("D6").Top
           .Visible = msoCTrue
          End With
        End If
        'On Error Goto 0
        .Range("E10:F10").ClearContents 'Clear Iteam Iteam
        .Range("E10").Select
        End With
        End Sub

    ...................................................................................................

    This is sheet 1 code

    Private Sub Worksheet_Change(ByVal Target As Range)
    'on change of item, if row found and add to receipt
    If Not Intersect(Target, Range("E10")) Is Nothing And Range("E10").Value <> Empty Then Additem

    End Sub

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    'On Selection of Receipt Item, load Item details
    If Not Intersect(Target, Range("K10:N9999")) Is Nothing And Range("K" & Target.Row).Value <> Empty Then Additem
        Range("B6").Value = Target.Row 'Selected Row
        Range("B4").Value = True
        Range("E3").Value = Range("K" & Target.Row).Value 'Item Name
        Range("F8").Value = Range("L" & Target.Row).Value 'Item Qty
        Range("F6").Value = Range("M" & Target.Row).Value 'Item Price
        Range("B4").Value = False
    End If


    End Sub

                

    Wednesday, August 19, 2020 11:41 PM

All replies

  • HI kindly help me on this im new to vb

    Wednesday, August 19, 2020 11:43 PM
  • Possibly the problem is in

    "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"

    **********************************************

    Pls ensure that after "Then" there will be no word and "AddItem" must appear in next line.

    Cause in VBA IF block can be of single line if i) only true part is required and ii) Only one instruction is there.

    If the "AddItem" appears in same line VB Editor, it will be complete IF Block and "Range("B6").Value = Target.Row" will be outside of IF Block. So that last "End If" is considered extra and error raised.



    Best Regards, Asadulla Javed


    Thursday, August 20, 2020 5:51 AM
    Answerer