Engalpengal
New Member
- Joined
- May 10, 2023
- Messages
- 43
- Office Version
- 365
- Platform
- Windows
Hi all.
I am new to VBA programming but am in progress to learn how to use this wonderful tool.
Unfortunately, I cannot share the document due to its contents and that the information belongs to the company I work for. But I will try to explain what I am working on.
I have a long list of customer orders. Based on this list, I want to be able to extract a specific order. An order can have several product lines in the customer order list, but each product line refers to a given order no. Order no is shown in column B
Order list -> Sheets(«Customer order»).Range(«B24:M1000») - The product lines contain both numbers, dates and text, with and without formulas.
In another sheet in the same file, we enter a desired order number (this is entered manually in a given cell),
Order number -> Sheets("LA").Range("F6")
which retrieves all the product lines linked to the given order no for review.
When the person in question has reviewed the order, I want him or her to be able to, by pressing a button, copy (only value, text and numbers, not formatting or formulas) all order lines in the order list that match the order number in given cell -> Sheets("LA").Range("F6").
These order lines must now be pasted into a list for order history, first available row.
Order history -> Sheets("LA").Range("P:AA") - First row is P5:AA5
I have tried countless compositions I have found online but have not quite managed to adapt them to my needs.
The last one I have tried is the following:
Sub Ferdig_LASen()
Dim c As Range, wsSrc As Worksheet, wsOut As Worksheet, wb As Workbook
Dim cDest As Range, wsTrans As Worksheet, rngList As Range
Set wb = ThisWorkbook
Set wsSrc = wb.Worksheets("Kundeordre") 'orderlist, search area
Set wsOut = wb.Worksheets("LA") 'Paste area
Set wsTrans = wb.Worksheets("LA")
Set rngList = wsTrans.Range("F6") 'order no, search key
wsSrc.Rows(1).Copy wsOut.Rows(1)
Set cDest = wsOut.Range("P5:AA5") 'first paste destination
Application.ScreenUpdating = False
For Each c In wsSrc.Range("B24:B" & wsSrc.Cells(Rows.Count, "B").End(xlUp).Row).Cells
If Not IsError(Application.Match(c.Value, rngList, 0)) Then 'any match in lookup list?
c.EntireRow.Copy cDest
Set cDest = cDest.Offset(1) 'next paste row
End If
Next c
Application.ScreenUpdating = True
End Sub
There are probably many errors in this programming that I cannot see myself, so I need your expertise.
Hope my explanation and situation is understandable, and feel free to ask questions give feedback.
Thank you for your attention.
Look forward to your suggestions
I am new to VBA programming but am in progress to learn how to use this wonderful tool.
Unfortunately, I cannot share the document due to its contents and that the information belongs to the company I work for. But I will try to explain what I am working on.
I have a long list of customer orders. Based on this list, I want to be able to extract a specific order. An order can have several product lines in the customer order list, but each product line refers to a given order no. Order no is shown in column B
Order list -> Sheets(«Customer order»).Range(«B24:M1000») - The product lines contain both numbers, dates and text, with and without formulas.
In another sheet in the same file, we enter a desired order number (this is entered manually in a given cell),
Order number -> Sheets("LA").Range("F6")
which retrieves all the product lines linked to the given order no for review.
When the person in question has reviewed the order, I want him or her to be able to, by pressing a button, copy (only value, text and numbers, not formatting or formulas) all order lines in the order list that match the order number in given cell -> Sheets("LA").Range("F6").
These order lines must now be pasted into a list for order history, first available row.
Order history -> Sheets("LA").Range("P:AA") - First row is P5:AA5
I have tried countless compositions I have found online but have not quite managed to adapt them to my needs.
The last one I have tried is the following:
Sub Ferdig_LASen()
Dim c As Range, wsSrc As Worksheet, wsOut As Worksheet, wb As Workbook
Dim cDest As Range, wsTrans As Worksheet, rngList As Range
Set wb = ThisWorkbook
Set wsSrc = wb.Worksheets("Kundeordre") 'orderlist, search area
Set wsOut = wb.Worksheets("LA") 'Paste area
Set wsTrans = wb.Worksheets("LA")
Set rngList = wsTrans.Range("F6") 'order no, search key
wsSrc.Rows(1).Copy wsOut.Rows(1)
Set cDest = wsOut.Range("P5:AA5") 'first paste destination
Application.ScreenUpdating = False
For Each c In wsSrc.Range("B24:B" & wsSrc.Cells(Rows.Count, "B").End(xlUp).Row).Cells
If Not IsError(Application.Match(c.Value, rngList, 0)) Then 'any match in lookup list?
c.EntireRow.Copy cDest
Set cDest = cDest.Offset(1) 'next paste row
End If
Next c
Application.ScreenUpdating = True
End Sub
There are probably many errors in this programming that I cannot see myself, so I need your expertise.
Hope my explanation and situation is understandable, and feel free to ask questions give feedback.
Thank you for your attention.
Look forward to your suggestions
