VBA - Copy to Master List; Question with Loop / Cleaning up Code

ElRugg

New Member
Joined
Jun 26, 2020
Messages
8
Office Version
  1. 2016
Platform
  1. Windows
Hi all, I'm fairly new at this and most of what I've learned has been cobbled together from Google searches. I was able to work together a code that does what I need it to do, but thinking there has to be a shorter and easier way to do the same thing.

I have a form worksheet "PO Form" for Purchase Orders including info such as a Purchase Order #, Vendor name, item #, item description, quantity, cost. I want to copy the information from the form into a worksheet to create basically a master list of all the items with one row per item. I've attached 2 pictures showing what each worksheet looks like. Where I'm having issues is that there can be multiple items on one purchase order but each item has to refer to the same PO and vendor.

So here's what I have for the first line item:

VBA Code:
Sheets("PO Form").Select
    Range("B17").Select
    Selection.Copy
    Sheets("PO List").Select
    Range("E1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
 
Sheets("PO Form").Select
    Range("B4").Select
    Selection.Copy
    Sheets("PO List").Select
    Selection.End(xlToLeft).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
 
Sheets("PO Form").Select
   Range("B3").Select
   Selection.Copy
   Sheets("PO List").Select
   ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
 
Sheets("PO Form").Select
   Range("B6").Select
   Selection.Copy
   Sheets("PO List").Select
   ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
 
Sheets("PO Form").Select
   Range("a17").Select
   Selection.Copy
   Sheets("PO List").Select
   ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
 
Sheets("PO Form").Select
   Range("c17").Select
   Selection.Copy
   Sheets("PO List").Select
   ActiveCell.Offset(0, 2).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
 
Sheets("PO Form").Select
   Range("d17").Select
   Selection.Copy
   Sheets("PO List").Select
   ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

and then for each additional line in the range of possible items, I have it set up as an "If" so that nothing is copied if there's only 1 item but does copy everything if there's additional items:

VBA Code:
Sheets("PO Form").Select
   Range("B18").Select 
 
If IsEmpty(ActiveCell) Then
Else


End If

Where below Else, I basically have it copied from above. Between the long string of copying and then a long string of ranges B18:B30 (for the different line items), it's a really lengthy code.

I'm thinking there has to be a way to use loop to shorten this, and probably also ways to clean it up. The code I have now does what I want so I could leave it as is but in part for my own knowledge, help would be appreciated!

Any other info I could provide, let me know!
 

Attachments

  • PO Form.png
    PO Form.png
    34.5 KB · Views: 3
  • PO List.png
    PO List.png
    8.8 KB · Views: 3

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,969
Office Version
  1. 365
Platform
  1. Windows
Hi & welcome to MrExcel.
How about
VBA Code:
Sub ElRugg()
   Dim NxtRw As Long
   Dim Ws As Worksheet
   
   Set Ws = Sheets("PO List")
   NxtRw = Ws.Range("E" & Rows.Count).End(xlUp).Offset(1).Row
   
   With Sheets("PO Form")
      If .Range("B18").Value = "" Then
         .Range("A17:E17").Copy Ws.Range("D" & NxtRw)
         Rws = 1
      Else
         Rws = .Range("B17").End(xlDown).Row - 16
         .Range("A17").Resize(Rws, 5).Copy Ws.Range("D" & NxtRw)
      End If
      .Range("B4").Copy Ws.Range("A" & NxtRw).Resize(1 * Rws)
      .Range("B3").Copy Ws.Range("B" & NxtRw).Resize(1 * Rws)
      .Range("B6").Copy Ws.Range("C" & NxtRw).Resize(1 * Rws)
   End With
End Sub
 

ElRugg

New Member
Joined
Jun 26, 2020
Messages
8
Office Version
  1. 2016
Platform
  1. Windows
Closer! 2 things though:

- I was using paste formulas to keep the formatting of the PO List spreadsheet rather than the formatting from the Form.

- I didn't need column E copied, although that doesn't matter much.

Thanks so much!
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,969
Office Version
  1. 365
Platform
  1. Windows
Ok, how about
VBA Code:
Sub ElRugg()
   Dim NxtRw As Long, Rws As Long
   Dim Ws As Worksheet
   
   Set Ws = Sheets("PO List")
   NxtRw = Ws.Range("E" & Rows.Count).End(xlUp).Offset(1).Row
   
   With Sheets("PO Form")
      If .Range("B18").Value = "" Then
         Ws.Range("D" & NxtRw).Resize(, 4).Value = .Range("A17:D17").Value
         Rws = 1
      Else
         Rws = .Range("B17").End(xlDown).Row - 16
         Ws.Range("D" & NxtRw).Resize(Rws, 4).Value = .Range("A17").Resize(Rws, 4).Value
      End If
      Ws.Range("A" & NxtRw).Resize(, 3).Value = Array(.Range("B4").Value, .Range("B3").Value, .Range("B6").Value)
      Ws.Range("A" & NxtRw).Resize(Rws, 3).FillDown
   End With
End Sub
 

ElRugg

New Member
Joined
Jun 26, 2020
Messages
8
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

Perfect! Thanks again!
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,969
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 

ElRugg

New Member
Joined
Jun 26, 2020
Messages
8
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

Alright, so having used this for a few weeks, it unfortunately isn't doing what I want it to every time.

I need it to copy the date, Po # and company from the form sheet to the list, and sometimes it does that. Other times it just shows the same info as the line above it. I'm not sure why sometimes it's right and other times it's not. Any idea to help?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,969
Office Version
  1. 365
Platform
  1. Windows
Can you please post some sample data using the XL2BB add-in.
 

ElRugg

New Member
Joined
Jun 26, 2020
Messages
8
Office Version
  1. 2016
Platform
  1. Windows
I haven't used the XL2BB add in before so I hope this works. Let me know if not:

This is the PO Form to be copied:

PO Database.xlsm
ABCDE
1Purchase Order
2
3PO Number:27049
4Date:7/17/2020
5
6Vendor:Enter VendorShip To:
7
8
9
10
11
12
13Shipping MethodShipping TermsJob Name / Reference
14  Test
15
16Item NumberDescriptionQuantityUnit PriceLine Total
17TestTest1$2.00$2.00
18 
19 
20 
21 
22 
23 
24 
25 
26 
27 
28 
29
30 
31Subtotal$2.00
32Comments:Tax
33Shipping
34Total$2.00
35
36
37Authorized By:Date:
PO Form
Cell Formulas
RangeFormula
A14A14=IFERROR(VLOOKUP(B6, Vendor,8, FALSE),"")
B14B14=IFERROR(VLOOKUP(B6, Vendor,9, FALSE),"")
E30,E17:E28E17=C17*D17
E31E31=SUM(E17:E30)
E34E34=SUM(E31:E33)


This is the page PO List page. Row 2 was entered previously. Row 3 is where the info matching the PO form should be copying. As you should be able to see in A3:C3, it's showing the data from the above row rather than the new form data.

PO Database.xlsm
ABCDEFG
1PO DatePO #VendorItem #Item DescriptionQty Cost/Item
27/16/2027048Amazon2 Items: requested by Ted
37/16/2027048AmazonTestTest1$2.00
PO List


Thanks!
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,969
Office Version
  1. 365
Platform
  1. Windows
Ok thanks for that, make this change
Rich (BB code):
      ws.Range("A" & NxtRw).Resize(, 3).Value = Array(.Range("B4").Value, .Range("B3").Value, .Range("B6").Value)
      If Rws > 1 Then ws.Range("A" & NxtRw).Resize(Rws, 3).FillDown
   End With
 

Watch MrExcel Video

Forum statistics

Threads
1,130,314
Messages
5,641,480
Members
417,210
Latest member
rins

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top