VBA to create a template for my formula

P

PorterGlenn

New Member
Joined
Feb 25, 2015
Messages
4
Hello all,

Monthly I have to reconcile a list of invoices on my end with our suppliers list of invoices. Theoretically this should be the same, but inevitably every month we are missing some of their invoices, and they are missing some of their invoices. (how are they missing their own invoices?!)

A vlookup works to figure out who needs copies of what invoices but running the vlookup on our list, and then on their list gets really confusing to actually figure out who needs what invoices.

So I created a monster formula that uses INDEX/MATCH formulas, a bunch of IF statements, and ultimate spits out a response that I can quickly review to find out what needs to be done with that specific invoice.

My monster formula uses a master list of all invoices which is compiled by copying all of our invoice numbers, and all of their invoice numbers into column L, then removing the duplicates. Then with a true list of ALL the invoices for a given month I run my formula in column M.

The formula then matches the invoice number from the master list in column L to column B (their invoice list) and column G (my invoice list) if there is no match it reports that either they need, or I need a copy of that invoice. Then if we both have the invoice the formula compares the price and the store # of the invoice.

My headache is coming from having to format both their and our invoice list, to get all the information into the appropriate columns so that my formula is pulling/comparing the correct data. This really only takes a few minutes to actually copy and paste the columns, but to read through the formula and re-learn exactly what order everything needs to be in has gotten really annoying. If I did it daily I would probably remember all this stuff but by the time next month rolls around I have for the most part completely forgotten everything. Note I did try making notes for myself but seemingly every time I somehow messed something up and then had to trouble shoot for seemingly an hour.

I really want to create a Macro that will just take the raw data from their system and our system and put it in order and then run my formula on the master invoice list in column L. I have basically no idea how to do this, but feel like this should be a relatively simple VBA code? I realize I will have to copy and paste both our data and theirs into the spreadsheet to get every thing started and I am find with that.

So their info comes in like so:
Column A: Date
Column B - D: useless info
Column E: Ticket #
Column F - J: useless info
Column K: Price
Column L: Store #
Which I copy and paste the entire thing to my workbook and title the tab Their RAW

Our info is pulled and comes in as so:
Column A: Ticket #
Column B: Date
Column C: useless info
Column D: Store #
Column E - S: useless info
Column T: Price
which I copy and past the entire thing to my workbook and title the tab My RAW

The goal is to then get everything to the third tab titled Worksheet in the following format:
Column A: Their RAW.column A
Column B: Their RAW.column E
Column C: Their RAW.column K
Column D: Their RAW.column L
Column E: left blank
Column F:My RAW.column B
Column G: My RAW.column A
Column H: My RAW.column T
Column I: My RAW.column D
Column J: left blank
Column K: left blank
Column L: copy and paste all invoices from Their RAW.column E and My RAW.column A and then remove duplicates
Column M: My formula that runs off the invoice number in column L, it would be nice if the macro could be dragged down so it generates a response for every invoice # in column L

Also please note that we don't have the same number of invoices each month so I cant just copy the columns down to row x, and if it matters I'm dealing with around 3,000 invoices a month.

If anything else is needed please let me know.
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Sort by date Sort by votes
Welcome to the MessageBoard!

This should Work:

Put the files on your desktop. Then use Template.

DropBox Link: CLICK HERE FOR FILE

Code: 
[COLOR=#0000ff]Sub[/COLOR] DataImport()

  [COLOR=#0000ff]  Dim [/COLOR]TheirLastRow   [COLOR=#0000ff]As Long[/COLOR]
    [COLOR=#0000ff]Dim[/COLOR] MyLastRow      [COLOR=#0000ff]As Long[/COLOR]
   [COLOR=#0000ff] Dim [/COLOR]MaxLrow       [COLOR=#0000ff] As Long[/COLOR]
[COLOR=#0000ff]    Dim [/COLOR]TheirFPath     [COLOR=#0000ff]As Variant[/COLOR]
  [COLOR=#0000ff]  Dim [/COLOR]MyFPath        [COLOR=#0000ff]As Variant[/COLOR]
   [COLOR=#0000ff] Dim [/COLOR]ThisWB       [COLOR=#0000ff]  As String[/COLOR]
   [COLOR=#0000ff] Dim[/COLOR] MyFName        [COLOR=#0000ff]As String[/COLOR]
[COLOR=#0000ff]    Dim[/COLOR] TheirFName    [COLOR=#0000ff] As String[/COLOR]
    
    Application.ScreenUpdating = [COLOR=#0000ff]False[/COLOR] [COLOR=#008000]'Turn Off For Speed[/COLOR]
    Application.DisplayAlerts = [COLOR=#0000ff]False[/COLOR]
[COLOR=#0000ff]    On Error GoTo[/COLOR] ErrorTrap [COLOR=#008000]'Set Error Handling[/COLOR]
    ThisWB = ThisWorkbook.Name [COLOR=#008000]'Get Workbook Name to Toggle Between Windows (Files)[/COLOR]
    
[COLOR=#008000]    'Get Their RAW Data Export+++++++++++++++++++++++++[/COLOR]
    ChDrive "C"[COLOR=#008000] 'Define Drive[/COLOR]
    ChDir "C:\Users\" & Environ("Username") & "\Desktop\" [COLOR=#008000]'Define User DeskTop[/COLOR]
    TheirFPath = Application.GetOpenFilename(FileFilter:="Excel Files, *.xlsx; *.csv", Title:="Select Their Raw Data Reference File")[COLOR=#008000] 'File Dialog[/COLOR]
    Workbooks.Open TheirFPath [COLOR=#008000]'Open File[/COLOR]
    TheirFName = ActiveWorkbook.Name [COLOR=#008000]'Define Opened Workbook Name[/COLOR]
    TheirLastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row[COLOR=#008000] 'Define Last Row based on column that always contains data (no nulls)[/COLOR]
    Range("A1:L" & TheirLastRow).Copy [COLOR=#008000]'Change Accordingly ---> Copy Data[/COLOR]
    Windows(ThisWB).Activate
    Sheets("Their RAW").Range("A1").PasteSpecial [COLOR=#008000]'Paste Data[/COLOR]
    Windows(TheirFName).Activate
    Workbooks(TheirFName).Close False [COLOR=#008000]'Close File Do Not Save Changes[/COLOR]
    
    
[COLOR=#008000]    'Get My RAW Data Export +++++++++++++++++++++++++++[/COLOR]
    ChDrive "C" [COLOR=#008000]'Define Drive[/COLOR]
    ChDir "C:\Users\" & Environ("Username") & "\Desktop\"[COLOR=#008000] 'Define User DeskTop[/COLOR]
    MyFPath = Application.GetOpenFilename(FileFilter:="Excel Files, *.xlsx; *.csv", Title:="Select My Raw Data Reference File") [COLOR=#008000]'File Dialog[/COLOR]
    Workbooks.Open MyFPath[COLOR=#008000] 'Open File[/COLOR]
    MyFName = ActiveWorkbook.Name[COLOR=#008000] 'Define Opened Workbook Name[/COLOR]
    MyLastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row[COLOR=#008000] 'Define Last Row based on column that always contains data (no nulls)[/COLOR]
    Range("A1:T" & MyLastRow).Copy[COLOR=#008000] 'Change Accordingly ---> Copy Data[/COLOR]
    Windows(ThisWB).Activate
    Sheets("My RAW").Range("A1").PasteSpecial [COLOR=#008000]'Paste Data[/COLOR]
    Windows(MyFName).Activate
    Workbooks(MyFName).Close False [COLOR=#008000]'Close File Do Not Save Changes[/COLOR]
    
[COLOR=#008000]    '++++++++++++++++++++++++++++++++++++++++++++++++++
    'At this point all of the data is  in your template workbook
    '++++++++++++++++++++++++++++++++++++++++++++++++++[/COLOR]
    
 [COLOR=#008000]   'Move Appropriate Data To Consolidated Worksheet+++[/COLOR]
    Sheets("Their RAW").Range("A1:A" & TheirLastRow).Copy Sheets("Worksheet").Range("A1")
    Sheets("Their RAW").Range("E1:E" & TheirLastRow).Copy Sheets("Worksheet").Range("B1")
    Sheets("Their RAW").Range("K1:K" & TheirLastRow).Copy Sheets("Worksheet").Range("C1")
    Sheets("Their RAW").Range("L1:L" & TheirLastRow).Copy Sheets("Worksheet").Range("D1")
    Sheets("My RAW").Range("B1:B" & MyLastRow).Copy Sheets("Worksheet").Range("F1")
    Sheets("My RAW").Range("A1:A" & MyLastRow).Copy Sheets("Worksheet").Range("G1")
    Sheets("My RAW").Range("T1:T" & MyLastRow).Copy Sheets("Worksheet").Range("H1")
    Sheets("My RAW").Range("D1:D" & MyLastRow).Copy Sheets("Worksheet").Range("I1")
    
   [COLOR=#008000] 'Copy Additional Data and Remove Duplicates++++++++[/COLOR]
    Sheets("Their RAW").Range("E1:E" & TheirLastRow).Copy Sheets("Worksheet").Range("L1")
    Sheets("Worksheet").Range("L:L").RemoveDuplicates Columns:=1, Header:=xlYes
    Sheets("My RAW").Range("E1:E" & TheirLastRow).Copy Sheets("Worksheet").Range("M1")
    Sheets("Worksheet").Range("M:M").RemoveDuplicates Columns:=1, Header:=xlYes
    
    MaxLrow = Application.Max(ActiveSheet.Range("M" & Rows.Count).End(xlUp).Row, ActiveSheet.Range("L" & Rows.Count).End(xlUp).Row)
   
 [COLOR=#ff0000]   'Put your Formula Here <---- Change Accordingly++++[/COLOR]
    [COLOR=#ff0000]Sheets("Worksheet").Range("N2:N" & MaxLrow) = "YOUR FORMULA HERE"[/COLOR]
    
    [COLOR=#0000ff]On Error GoTo 0[/COLOR] [COLOR=#008000]' Reset Error Handling[/COLOR]
    
    [COLOR=#008000]'Clear Variables[/COLOR]
    TheirLastRow =[COLOR=#0000ff] Empty[/COLOR]
    MyLastRow = [COLOR=#0000ff]Empty[/COLOR]
    MaxLrow = [COLOR=#0000ff]Empty[/COLOR]
    TheirFPath = [COLOR=#0000ff]Empty[/COLOR]
    MyFPath = [COLOR=#0000ff]Empty[/COLOR]
    ThisWB = vbNullString
    MyFName = vbNullString
    TheirFName = vbNullString
    
    Application.ScreenUpdating = [COLOR=#0000ff]True[/COLOR] [COLOR=#008000]'Toggle Back On[/COLOR]
    Application.DisplayAlerts = [COLOR=#0000ff]True[/COLOR]
    
  [COLOR=#0000ff]  Exit Sub[/COLOR]
     
ErrorTrap:

    If TheirFPath Or MyFPath = False Then
    MsgBox UCase(Environ("UserName")) & " did not select a reference file." _
    & Chr(13) & "Data Import has been aborted!", vbCritical, "MyTemplate - Error Handler"
    End If
    
[COLOR=#008000]    'Clear Variables[/COLOR]
    TheirLastRow = [COLOR=#0000ff]Empty[/COLOR]
    MyLastRow = [COLOR=#0000ff]Empty[/COLOR]
    MaxLrow = [COLOR=#0000ff]Empty[/COLOR]
    TheirFPath = [COLOR=#0000ff]Empty[/COLOR]
    MyFPath = [COLOR=#0000ff]Empty[/COLOR]
    ThisWB = vbNullString
    MyFName = vbNullString
    TheirFName = vbNullString
    
    Application.ScreenUpdating = [COLOR=#0000ff]True[/COLOR] [COLOR=#008000]'Toggle Back On[/COLOR]
    Application.DisplayAlerts = [COLOR=#0000ff]True[/COLOR]
[COLOR=#0000ff]
End Sub[/COLOR]


Sometimes it may be helpful to post smaller tasks one at a time and then consolidate them for your end "Magnus Opum".
You will usually get a better response that way.
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

megera716
  • Question
MAXIFS to take the MAX of two columns
Replies
1
Views
185
shift-del
shift-del
K
  • Question
Hello what is the best formula to find missing invoices? someone told me this formula but it doesnt really work?
Replies
6
Views
148
kingjet
K
C
  • Question
Drag Path Down Changing Part of the Path (VBA?)
Replies
6
Views
212
Code Ghost
C
C
  • Locked
  • Question
Drag Path Down Changing Part of the Path (VBA?) UPDATED
Replies
2
Views
149
Joe4
Joe4
T
  • Question
A semi-advanced matching problem which may be solved with formulization or VBA
Replies
1
Views
184
The Godfather
T

Forum statistics

Threads
1,217,249
Messages
6,135,475
Members
449,940
Latest member
Yna26

Share this page

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
Back
Top