Order item

[KlausW]

Hi Excel helpers

I got this VBA code from one from here MrExcel to the registers whether one eats or not that run it really well. Now I have tried to make it so that it can be used to order goods. But it does not really succeed.

I change the Item in this by using the drop-down list in cell G2, but it shall not be in this way.



When I search in the Combo box in sheet Bestilling, the items appear in column B and I write the number in column C, then I press the order button Order and the number of items comes over in sheet Vare, in column G, the item name is in column C, but I can get the VBA code to put the item number in another column.

If I type another name in the Combo box, those names appear in the Bestilling sheet column B. And I can enter the number in column C, etc. If I write a name I have already ordered, the name appears in column B and the number in column C.

The only column I shall make a change in is column C and J

I would like the names of the items to start in sheet Bestilling column B9 and below. And that I can order in all the items, now I can only order in some of them.

All with red will be hidden.

Hope it makes sense.

All help will be appreciated

Best Regards

Klaus W
Order UK

In the Sheet Bestilling

In the Sheet Bestilling

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub

If Intersect(Target, Range("A2", "G2")) Is Nothing Then Exit Sub


Dim WkRng, DestRng, SrcRng As Range

Dim TidCol, TidRow, c  As Integer


 With Sheets("Bestilling")

    Set WkRng = .Range("B4:B10")  'Dates for week number

    Set DestRng = .Range("C4:C10")  'Required qty range

   

    On Error GoTo Ooops  'Error handler

    'TidCol = first column of initial

    'TidRow = first row of week number

       TidCol = Application.Match(.Range("A2"), Sheets("Vare").Range("1:1"), 0)

       TidRow = Application.Match(.Range("G2"), Sheets("Vare").Range("B:B"), 0)

 End With

Application.EnableEvents = False  'Stop this change event code triggereing itself and looping forever

'change the dates to match week number

WkRng.Value = Sheets("Vare").Cells(TidRow, 3).Resize(7, 1).Value


'Loop using offset to get 3 sets of data from Tid to cols C E G

For c = 0 To 2

    Set SrcRng = Sheets("Vare").Cells(TidRow, TidCol).Offset(0, c).Resize(7, 1)

    DestRng.Offset(0, 2 * c).Value = SrcRng.Value

Next c

 Ooops:  'Error message if there is error.

 If Not Err.Number = 0 Then MsgBox " Not able to match Initial or Week Number  -- Please check and try again"


On Error GoTo 0  'set error handling back to default

Application.EnableEvents = True  're-enable events handling


End Sub

In module 1

Sub Rektangelafrundedehjørner4_Klik()

Dim DatRng, Dest As Range
Dim TidCol, TidRow, c  As Integer

 With Sheets("Bestilling")
    Set DatRng = .Range("C4:C10")
 On Error GoTo Ooops
    TidCol = Application.Match(.Range("A2"), Sheets("Vare").Range("1:1"), 0)
    TidRow = Application.Match(.Range("B4"), Sheets("Vare").Range("C:C"), 0)
 End With
 
For c = 0 To 2
    Set Dest = Sheets("Vare").Cells(TidRow, TidCol).Offset(0, c).Resize(7, 1)
    Dest.Value = DatRng.Offset(0, 2 * c).Value
 Next c
 
Ooops:
 If Not Err.Number = 0 Then MsgBox " Not able to match Initial or Date  -- Please check and try again"
On Error GoTo 0

End Sub