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.
 
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

P
  • Question Question
Help with a formula
Replies
6
Views
246
paulsolar
P
N
  • Question Question
Locate Cell and enter corresponding value into new cell
Replies
3
Views
174
myall_blues
myall_blues
I
  • Question Question
Copy data to another sheet depending on input of currency
2 3
Replies
22
Views
565
ianharper68
I
N
  • Question Question
EXCEL VBA COMBO BOX/DROP DOWN LIST
Replies
1
Views
459
Peter_SSs
Peter_SSs
C
  • Question Question
SUMIF being used to compare differences between lists, not working correctly
Replies
1
Views
329
StephenCrump
S

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