Link to home
Start Free TrialLog in
Avatar of JaseSt
JaseStFlag for United States of America

asked on

Importing Liberty Reserve Emails to Mastercard Workbook

goflow

We now have another type of wire that comes in: Liberty Reserve.

As with the Earthport emails, I am now emailed notifications of Liberty Reserve transfers to our account and I need to extract data from the email and import that data to the spreadsheet.

For right now, this will only be for the Mastercard workbook. If possible and advisable by you, I'd like this requested function to kick off when the 'Import Emails into Tabs' is clicked. If you don't advise that, then another button is okay.

Attached are three example emails I receive. I also paste one here. I inserted the dashes here. They do not come in the email.

----------------------------

You have received a payment to your account U4539463 (Sovereign Management and Legal S.A.):

Date: 10/5/2012 4:05 PM
Batch: 113286631
From Account: U6489174 (Walter)
Amount: $4,400.00
Memo: Payment Ref Number 344159454545 Dave Hill

Thank you.

----------------------------

I need to extract all the information and insert the values into the correct spreadsheet of the MasterCard workbook.

So here's the formula:

Where the email 'From Account' value = the spreadsheet value in E2
AND the email 'Amount' is in USD (has a $ sign) THEN

- email 'Date' value imports to Col G with the words 'Liberty Reserve' as follows:
Liberty Reserve - 10/8/2012
- email 'Batch' value imports to Col N
- email 'From Account' value needs to match cell E2 before anything happens
- email 'Amount' value imports to Col F which kicks off the formula as it now normally does (except the formula is different for Liberty Reserve - see below **)
- email 'Memo' value is inserted in Col O

** Inserting a the value in Col F WHEN the value of E2 = the 'From Account' value AND
the email 'Amount' is in USD (has a $ sign) will kick off the formula exactly as it does when a value is put into Col F EXCEPT the Adjusted Wired Request (Col i) will NOT be:

=IF(F3*1.85%<25,F3-30,F3-(F3*1.85%)-5)

but instead:
=IF(F3*5%<25,F3-25,F3-(F3*5%))

Fwd-Liberty-Reserve-Payment-Rece.msgFwd-Liberty-Reserve-Payment-Rece.msgFwd-Liberty-Reserve-Payment-Rece.msg
Avatar of Jacques Geday
Jacques Geday
Flag of Canada image

First observation
will the subject for these emails be:
Fwd: Liberty Reserve Payment Received

OR
Liberty Reserve Payment Received

???
Avatar of JaseSt

ASKER

Fwd: Liberty Reserve Payment Received
Avatar of JaseSt

ASKER

Thank you, alias99, but I had scrubbed and altered email addresses and data contained in the uploaded documents.
ok so now lets summ it up

1) we have for this routine all of the following Subjects to be possibly captured and their respective emails treated. Pls confirm all three below subjects are still in effect:
Payment Received
Bank Transfer #
Fwd: Liberty Reserve Payment Received

2) You mention:
Where the email 'From Account' value = the spreadsheet value in E2
As I do not have any of these new Sheets I will need you to post (scrubbed for sure) some of these worksheets so I see what part of the name exist in E2 as it is not clear the sample you posted has:
From Account: U6489174 (Walter)
Will E2 contain: U6489174 (Walter) or (Walter) or Walter or U6489174 ???

Pls advise.
gowflow
Avatar of JaseSt

ASKER

I don't have any sheet that has a value in E2 either. As this Liberty Reserve option is new, I will be populating E2 as emails come in and then run the function. Or course, over time, when Liberty Reserve emails come in sheets will already have a value in E2.

E2 will just contain the number and not the name or anything else, so in the example you give, E2 will contain U6489174 only.
and the worksheet name will then be also U6489174 ?? if yes then what is the format of this worksheet ? if not then what are we updating here ? I am a bit confused
gowflow
Avatar of JaseSt

ASKER

No, the worksheet name will be the name of the customer name. We are using the same sheets (but different columns) that we use for the 'Import Emails to Tabs' function.
Pls you are giving them a bit by bit here !!!!
So E2 should bare U6489174 and the sheet name Walter ???? Why all this is missing from your original post it is too much handling !!!! As I recall the previous routine was every thing after the From: was the account name and therefore the sheet name, here we are disceting the infinite dissection !! what if the name has 2 names and what if there is no () surrounding the name too many ifs and buts that make the handling quite heavy. Also an other observation you mention in your original post:
email 'Date' value imports to Col G with the words 'Liberty Reserve' as follows:
Liberty Reserve - 10/8/2012
This is totally against all logic in database conventions !!! you are mixing in the same column dates value and string values (Liberty Reserve - 10/8/2012 is no more a date it become a string value) so if for some reason you need to do some search and manipulation of rows you are no more able to recognise the date you should be very careful when it comes to such conclusions. My recommendation is to have the date alone in the date column and choose an other column that you can label Email origin or whatever and then have the Liberty Reserve plugged there. Unless you have very good reasons to mix date and string which you will need to advise.

gowflow
Avatar of JaseSt

ASKER

Let's say Joe Smith is a customer. Sometimes Joe sends a wire to us via Earthport and sometimes he sends us a wire via Liberty Reserve.

I don't want to have two sheets in the Mastercard workbook for Joe, just one. But in order to clearly indicate on his sheet one wire is a Liberty Reserve wire and another is an Earthport wire I need to have inserted in Col G the date and 'Liberty Reserve'. We do that already for Earthport wires where Col G gets the value: EP 10/09/12 so I'm not sure what the problem is.

I'm using E2 for to find the customer in the Mastercard workbook for Liberty Reserve wires the same way we use cell D2 to find the customer for Earthport wires.

Does this help?
Avatar of JaseSt

ASKER

And for the 'From Account' value in the Liberty Reserve email, we are only using the 'U' value. It appears that the number following the U is unique to the customer. We do not need, or want, the name in the parenthesis.
Avatar of JaseSt

ASKER

Maybe to conserve space in Col G we should put 'LR' and the date rather than Liberty Reserve.
Avatar of JaseSt

ASKER

So, in the Mastercard sheets, the column heading 'Monthly Total' found in cell E1 will change to 'LR Number'
Pls recap clear instructions on what you need together with the main post as with too much info is it confusing already. I would appreciate you cut paste the new instruction (all of them) so I will go by them.
tks gowflow
Avatar of JaseSt

ASKER

For a Liberty Reserve email, instead of the function, 'Import Emails into Tabs' looking for a match in cell D2 I need it to find its match in cell E2 where the 'From Account:' = the value in E2.

So here it is:

When the 'From Account:' = the value in E2 THEN
- 'Date:' goes to col G as: "LR 10/11/12"
- 'Batch' value imports to Col N
- 'Amount' value imports to Col F which kicks off the formula as it now normally does (except the formula is different for Liberty Reserve - see below **)
- 'Memo' value is inserted in Col O

For col i, the formula is:
 =IF(F3*5%<25,F3-25,F3-(F3*5%))
ok pretty clear for me. So let me recap as it seems you changed your mind from what you advised before:
When you say:
looking for a match in cell D2 I need it to find its match in cell E2 where the 'From Account:' = the value in E2.
then this means the Value in E2 will be in our previous example of
From Account: U6489174 (Walter)
E2 = U6489174 (Walter)

Pls confirm my understanding is correct as this is a pure translation of what you just wrote and this way I can proceed to building the new function. (I myself prefer much better this version and for the date you are correct as long as it follows a clear concise pattern then I have no problem with that.

gowflow
Avatar of JaseSt

ASKER

no, not:

From Account: U6489174 (Walter)
E2 = U6489174 (Walter)

but:

From Account: U6489174 (Walter)
E2 = U6489174

And just so I know you understand, Walter (as an example customer) may already have a sheet in the Mastercard workbook with B2, C2, D2 already filled out and values in Col F, Col G and others if he had previously sent Earthport wires.
So you need to create a whole new sheet for him with sheet name Walter and in E2 U6489174
??? how this is possible to have 2 sheets with the same name ? or the sheet name in this case is U6489174 and E2 = U6489174

pls clarify
gowflow
Avatar of JaseSt

ASKER

no, you don't create a new sheet for him. he will have his own sheet already. The sheet name will be the name, not the number
Dear JaseSt,

1) Make a copy of your latest MC file and give it a new name.
2) Open the new workbook and goto vba and doubleclick on module1
3) click on bottom left icon to view 1 sub at a time.
4) display the following subs/functions and delete all of them
ImportData5New
LocateEmailsToTabsNew
FindExcelTab
FillRowFormulas

5) Paste the below code after any end sub

Function ImportData5New(Body As String, ByVal RDate As Date, Row As Long, EmailType As String) As String
On Error GoTo Errhandler25
Dim WS As Worksheet
Dim CC As String
Dim CName As String
Dim Cur As String
Dim Amt As Double
Dim tmp As String
Dim sBatch As String
Dim sMemo As String
Dim sAccount As String
Dim Ifmacct As Integer
Dim MaxRow As Long, MaxRowH As Long
Dim P_LOADFEE As Double
Dim P_RESCOMM As Double
Dim A_MINLFEE As Double
Dim A_WIREFEE As Double

With wsMain
    P_LOADFEE = .Range("I20")
    P_RESCOMM = .Range("I21")
    A_MINLFEE = .Range("I22")
    A_WIREFEE = .Range("I23")
End With

tmpa = Split(Body, Chr(10))

For I = 0 To UBound(tmpa)
    
    '---> Find CC and CName
    If EmailType = "Liberty" Then
        st = InStr(1, tmpa(I), "From Account:", vbTextCompare)
        Ifmacct = 14
    Else
        st = InStr(1, tmpa(I), "From:", vbTextCompare)
        Ifmacct = 6
    End If
    
    If st <> 0 Then
        If Not IsNumeric(Mid(tmpa(I), st + Ifmacct, 1)) Or Mid(tmpa(I), st + Ifmacct, 1) <> "5" Then
            If IsNumeric(Mid(tmpa(I), st + Ifmacct, 1)) Then
                ImportData5New = Mid(tmpa(I), st + Ifmacct)
                Exit Function
            Else
                '---> Disabled the Exit Function to Trap MCR and HMF Emails
                ImportData5New = Mid(tmpa(I), st + Ifmacct)
                
                '---> Extra Manipulation for Liberty Emails, Extract Account and CName
                If EmailType = "Liberty" Then
                    st = InStr(1, ImportData5New, " ", vbTextCompare)
                    If st <> 0 Then sAccount = Left(ImportData5New, st - 1)
                    st = InStr(1, ImportData5New, "(", vbTextCompare)
                    If st <> 0 Then
                        CName = Mid(ImportData5New, st + 1, Len(ImportData5New) - st - 2)
                    End If
                    ImportData5New = ""
                End If
            End If
        Else
            tmpb = Split(Mid(tmpa(I), st + Ifmacct, InStr(st, tmpa(I), Chr(13), vbBinaryCompare)), " ")
            For J = 0 To UBound(tmpb)
                If IsNumeric(tmpb(J)) Then
                    CC = CC & tmpb(J)
                Else
                    Exit For
                End If
            Next J
            
            For K = J To UBound(tmpb)
                CName = CName & tmpb(K) & " "
            Next K
            CName = RTrim(CName)
        End If
    End If
    
    '--> Find Curency, Amt
    st = InStr(1, tmpa(I), "Amount:", vbTextCompare)
    If st <> 0 Then
        tmpb = Split(Mid(tmpa(I), st + 8, InStr(st, tmpa(I), Chr(13), vbBinaryCompare)), " ")
        If EmailType <> "Liberty" Then
            If UBound(tmpb) = 1 Then
                Cur = tmpb(0)
                Amt = tmpb(1)
            End If
        Else
            If UBound(tmpb) = 0 Then
                If Left(tmpb(0), 1) = "$" Then
                    Cur = Left(tmpb(0), 1)
                    Amt = tmpb(0)
                Else
                    Amt = tmpb(0)
                End If
            Else
                Cur = tmpb(0)
                Amt = tmpb(1)
            End If
        End If
    End If
    
    '--> Find Batch
    If EmailType = "Liberty" Then
        st = InStr(1, tmpa(I), "Batch:", vbTextCompare)
        If st <> 0 Then
            tmpb = Split(Mid(tmpa(I), st + 7, InStr(st, tmpa(I), Chr(13), vbBinaryCompare)), Chr(13))
            If UBound(tmpb) = 1 Then
                sBatch = tmpb(0)
            End If
        End If
    End If
    
    '--> Find Memo
    If EmailType = "Liberty" Then
        st = InStr(1, tmpa(I), "Memo:", vbTextCompare)
        If st <> 0 Then
            tmpb = Split(Mid(tmpa(I), st + 6, InStr(st, tmpa(I), Chr(13), vbBinaryCompare)), Chr(13))
            If UBound(tmpb) = 1 Then
                sMemo = tmpb(0)
            End If
        End If
    End If
Next I

'Save to Excel Tab
MsgBox ("looking for sheet to update")
If ImportData5New = "" Then
    
    '---> Added to distinguish handling of Liberty Emails v/s others
    If EmailType <> "Liberty" Then
        ShtName = FindExcelTab(CC, EmailType)
    Else
        ShtName = FindExcelTab(sAccount, EmailType)
    End If
Else
    If UCase(Mid(ImportData5New, 1, 3)) = "HMF" Then
        ShtName = "HMF Account"
    Else
        ShtName = "MCR " & ImportData5New
    End If
End If


'Application.ScreenUpdating = False
'Look for the sheet
FoundSheet = False
If ShtName <> "" And InStr(1, ShtName, Chr(13)) <> 0 Then ShtName = Trim(Left(ShtName, InStr(1, ShtName, Chr(13)) - 1))

For Each WS In ThisWorkbook.Worksheets
    If UCase(WS.Name) = UCase(ShtName) Then
        FoundSheet = True
        Exit For
    End If
Next WS

If FoundSheet = False Or ShtName = "" Then
    ImportData5New = "Sheet: " & CName & " Not Found"
    'Exit Function
Else

With Sheets(UCase(ShtName))
    .Activate
    '.UsedRange.Select
    MaxRow = .UsedRange.Rows.count + 1
    MaxRowH = .Range("H:H").Rows(.Range("H:H").Rows.count).End(xlUp).Row
    
    If ImportData5New = "" Then
        
        '---> Depending on Email Type process
        If EmailType <> "Liberty" Then
            .Cells(MaxRow, "F") = Amt
        Else
            .Cells(MaxRow, "G") = "LR " & Format(RDate, "mm/dd/yy")
            .Cells(MaxRow, "N") = Format(sBatch, "@")
            .Cells(MaxRow, "O") = sMemo
            .Cells(MaxRow, "F") = Amt
        End If
        
    Else
        .Cells(MaxRow, "A") = RDate
        .Cells(MaxRow, "F") = Amt
        If UCase(ShtName) <> "HMF ACCOUNT" Then
            If UCase(ShtName) <> "MCR FI2" Then
                'New Formula Col G =F2*1.35%  changed on 23/11/2011
                .Cells(MaxRow, "G").Formula = "=F" & MaxRow & "*(" & P_LOADFEE & "-" & P_RESCOMM & ")"
            Else
                'New Formula Col G =IF(F3*1.85%<25,30,(F3*1.85%)) Changed on 23/11/2011
                .Cells(MaxRow, "G").Formula = "=IF(F" & MaxRow & "*" & P_LOADFEE & "<" & A_MINLFEE & "," & A_MINLFEE & ",F" & "+" & A_WIREFEE & ",F" & MaxRow & "*" & P_LOADFEE
            
                'New Formula Col I  =F2-G2 Changed on 23/11/2011
                .Cells(MaxRow, "I").Formula = "=F" & MaxRow & "-G" & MaxRow
            End If
            'Old Formula
            '.Cells(MaxRow, "G").Formula = "=(F" & MaxRow & "*1.35%)"
        End If
        .Range("H" & MaxRowH & ":H" & MaxRow).FillDown
        .Range("H" & MaxRowH + 1 & ":H" & MaxRow).Interior.ColorIndex = 0
        
        'Added for Col H when there is a Deposit 23/11/2011
        .Range("H" & MaxRow).Formula = "=H" & MaxRow - 1 & "+F" & MaxRow & "-G" & MaxRow & "-J" & MaxRow & "-1*" & A_WIREFEE
        
        .Cells(MaxRow, "K") = DateValue(Now)
        If UCase(ShtName) <> "HMF ACCOUNT" Then
            .Cells(MaxRow, "L").Formula = "=G" & MaxRow
        End If
        .Range("A" & MaxRow & ":L" & MaxRow).Interior.ColorIndex = 4
   End If
    If CName = "" Then CName = ShtName
    wsMain.Range("L" & CRow) = "Import Data : <" & CName & " " & RDate
    CRow = CRow + 1
End With
    ImportData5New = ""

'Application.ScreenUpdating = True
'Application.EnableEvents = True

End If


Exit Function

Errhandler25:
MsgBox (Error(err))
wsMain.Range("L" & CRow) = "Import Data - Error: <" & Error(err) & "> Item " & CName & " " & RDate
CRow = CRow + 1

Resume Next

End Function



Sub LocateEmailsToTabsNew()
On Error GoTo Errhandler1

Dim FoundIt As Boolean
Dim Body As String
Dim MaxRow As Long, EmailMoved As Long, EmailNotMoved As Long, TotItems As Long
Dim I As Long, J As Long, K As Long, L As Long
Dim FMonitor, FTransfer
Dim tmpBody, tmpTransferLine
Dim TransAmount As Double
Dim EmailType As String

Set objOutlook = CreateObject("Outlook.application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
'Set objFolder = objNameSpace.Folders(gstFolderToMonitor)

FMonitor = Split(Mid(gstFolderToMonitor, 2), "\")
If Not SetMonitorFolder(FMonitor) Then Exit Sub
wsMain.Range("L" & CRow) = "Locate Emails - FMonitor: " & objFolderToMonitor
CRow = CRow + 1

FTransfer = Split(Mid(gstFolderToTransfer, 2), "\")
If Not SetTransferFolder(FTransfer) Then Exit Sub
wsMain.Range("L" & CRow) = "Locate Emails - FTransfer: " & objFolderToTransfer
CRow = CRow + 1

Dim VItem As Outlook.MailItem

Set VisaItems = objFolderToMonitor.items.Restrict("[Subject] = 'Payment Received' or ([Subject] >= 'Bank Transfer # ' and [Subject] <= 'Bank Transfer #z') or [Subject] = 'Liberty Reserve Payment Received'")
VisaItems.Sort "receivedtime", False
Set VItem = VisaItems.Find("[Subject] = 'Payment Received' or ([Subject] >= 'Bank Transfer # ' and [Subject] <= 'Bank Transfer #z') or [Subject] = 'Liberty Reserve Payment Received'")
TotItems = VisaItems.count
I = 1


Do
'For Each VItem In VisaItems
    wsMain.Range("L" & CRow) = "Locate Emails - VisaItems: " & I & " " & VItem.SenderEmailAddress & " " & VItem
    CRow = CRow + 1

    Set objMail = VItem
    
    Body = objMail.Body
    Etime = objMail.ReceivedTime
    
    '---> Determine Email Type
    Select Case objMail.Subject
        
        Case "Payment Received"
            EmailType = "Payment"
            
        Case "Fwd: Liberty Reserve Payment Received"
            EmailType = "Liberty"
            
        Case Is >= "Bank Transfer # ", Is <= "Bank Transfer #z", Is <> "Fwd: Liberty Reserve Payment Received"
            EmailType = "Transfer"
            
    End Select
    
    '---> Depending on Type of Mail route Import
    If InStr(1, objMail.Subject, "Bank Transfer #") <> 0 Then
        '---> Process Bank Transfer Emails
        tmpBody = Split(objMail.Body, Chr(10))
        st = "Bank Transfer"
        For K = 0 To UBound(tmpBody)
            If InStr(1, tmpBody(K), "Bank Transfer #") <> 0 And InStr(1, tmpBody(K), "for USD") <> 0 Then
                tmpTransferLine = Split(Right(tmpBody(K), Len(tmpBody(K)) - InStr(1, tmpBody(K), "for USD") + 1), " ")
                For L = 0 To UBound(tmpTransferLine)
                    If IsNumeric(tmpTransferLine(L)) Then
                        TransAmount = tmpTransferLine(L)
                        MaxRow = Sheets("MC Heritage Balance").Range("B1048576").End(xlUp).Row + 1
                        Sheets("MC Heritage Balance").Range("B" & MaxRow) = TransAmount
                        Sheets("MC Heritage Balance").Range("C" & MaxRow) = Etime
                        Exit For
                    End If
                Next L
                If st = "Bank Transfer" Then
                    st = ""
                    Exit For
                End If
            End If
        Next K
    Else
        st = ImportData5New(Body, Etime, MaxRow + 1, EmailType)
    End If
    
    'Application.EnableEvents = True
    If st <> "" Then
        MsgBox ("Email From: [" & st & "] not imported")
        EmailNotMoved = EmailNotMoved + 1
        If VItem.Categories <> "Processed" Then VItem.Categories = "Not Processed"
        VItem.Save
        wsMain.Range("L" & CRow) = "Locate Emails - Not Imported: <" & st & "> "
        CRow = CRow + 2

    Else
        'objMail.Move objFolderToTransfer
        'VItem.Move objFolderToTransfer
        EmailMoved = EmailMoved + 1
        VItem.Categories = "Processed"
        VItem.Save
        wsMain.Range("L" & CRow) = "Locate Emails - Imported and Not Moved: <" & VItem.SenderEmailAddress & "> "
        CRow = CRow + 2

    End If
    I = I + 1
    Set VItem = VisaItems.FindNext
Loop Until I = TotItems + 1

MsgBox ("Total Emails processed from '" & objFolderToMonitor & "' " & TotItems & Chr(10) _
    & "Total Emails Imported and Not Moved: " & EmailMoved & Chr(10) _
    & "Total Emails Not Imported: " & EmailNotMoved & " and kept in '" & objFolderToMonitor & "'" _
    & "Imported Emails were kept in : '" & objFolderToMonitor & "'")
wsMain.Range("L" & CRow) = ("Locate Emails - Total Emails processed from '" & objFolderToMonitor & "' " & TotItems _
    & "Total Emails Imported and Not Moved: " & EmailMoved _
    & "Total Emails Not Imported: " & EmailNotMoved & " and kept in '" & objFolderToMonitor & "'" _
    & "Imported Emails were kept in: '" & objFolderToMonitor & "'")
CRow = CRow + 1

Exit Sub

Errhandler1:
MsgBox (Error(err))
wsMain.Range("L" & CRow) = "Locate Emails - Error: <" & Error(err) & "> Item " & VItem
CRow = CRow + 1
Resume 'Next

End Sub





Function FindExcelTab(ByVal CC As String, EmailType As String) As String
Dim FoundIt As Boolean

For Each WS In ActiveWorkbook.Worksheets
If Mid(WS.Name, 1, 3) <> "MC " And _
       WS.Name <> "Main" And _
       WS.Name <> "Final Report" Then
    If EmailType <> "Liberty" Then
        If Len(WS.Range("D2")) > 15 Then
            If Left(Format(WS.Range("D2"), "#"), Len(Format(WS.Range("D2"), "#")) - 1) = Left(CC, Len(CC) - 1) Then
                MsgBox ("Found " & WS.Name)
                FoundIt = True
                Exit For
            End If
        End If
    Else
        If WS.Range("E2") = CC Then
            MsgBox ("Found " & WS.Name)
            FoundIt = True
            Exit For
        End If
    End If
End If
Next WS

If FoundIt Then
    FindExcelTab = WS.Name
Else
    FindExcelTab = ""
End If

End Function


Sub FillRowFormulas(WS As Worksheet, Target As Range)
Dim P_LOADFEE As Double
Dim P_RESCOMM As Double
Dim A_MINLFEE As Double
Dim A_WIREFEE As Double

With wsMain
    P_LOADFEE = .Range("I20")
    P_RESCOMM = .Range("I21")
    A_MINLFEE = .Range("I22")
    A_WIREFEE = .Range("I23")
End With

    'Application.EnableEvents = False
    On Error GoTo err
    'Set ws = ActiveSheet
    If UCase(Left(Trim(WS.Name), 11)) <> "HMF ACCOUNT" And _
       UCase(Left(Trim(WS.Name), 2)) <> "MC" And _
       UCase(Trim(WS.Name)) <> "MAIN" And _
       UCase(Trim(WS.Name)) <> "FINAL REPORT" And _
       UCase(Trim(WS.Name)) <> "SUMMARY" Then
       If Not Intersect(Target, WS.Columns(6)) Is Nothing And Len(Trim(Target.Value)) <> 0 Then
            With Sheets(WS.Name)
                I = Target.Row
                If IsNumeric(.Cells(I, 6).Value) Then
                    Application.ScreenUpdating = False
                    If .Range("G" & I).Value = "" Then
                        .Range("G" & I).Value = "EP " & Format(Date, "mm/dd/yy")
                    End If
                    
                    .Range("K" & I).Value = Date
                    .Range("K" & I).NumberFormat = "mm/dd/yy"
                    
                    Select Case UCase(Left(LTrim(WS.Name), 3))
                        Case "HMF", "OS " '=IF(F5*1.85%<25,F5-30,F5-(F5*1.35%)-5)
                            '.Range("I" & I).Formula = "=IF(F" & I & "*" & P_LOADFEE & "<" & A_MINLFEE & ",F" & I & "-1*(" & A_MINLFEE & ",F" & "+" & A_WIREFEE & "),F" & I & "-(F" & I & "*(" & P_LOADFEE & "-" & P_RESCOMM & ")-" & A_WIREFEE & ")"
                            
                            'Col L Formulas: =(F2-I2)-(F2*0.5%)
                            '.Range("L" & I).Formula = "=(F" & I & "-I" & I & ") - (F" & I & " * 0.5%)"
                            
                            'Col L New Formulas: =(F2-I2)*73% Changed on 23/11/2011
                            .Range("L" & I).Formula = "=(F" & I & "-I" & I & ")*(" & P_LOADFEE & " - " & P_RESCOMM & ") / " & P_LOADFEE
                            
                            'Col M Formulas: =0.5%*F2
                            '.Range("M" & I).Formula = "=(F" & I & "*" & P_RESCOMM & ")"
                            
                            'Col M New Formulas: =(F2-I2)*27% Changed on 23/11/2011
                            .Range("M" & I).Formula = "=(F" & I & "-I" & I & ")*(1-(" & P_LOADFEE & " - " & P_RESCOMM & ") / " & P_LOADFEE & ")"
                            
                        Case Else
                            'Col L  =F2-I2
                            .Range("L" & I).Formula = "=F" & I & "-I" & I
                            
                    End Select
                    'Cancelled old Formula on 23/11/2011
                    '.Range("I" & I).Formula = "=IF(F" & I & "*1.85%<25,F" & I & "-30,F" & I & "-(F" & I & "*1.85%)-5)"
                    
                    If Left(.Range("G" & I).Value, 2) = "LR" Then
                        '---> Col I  =IF(F5*5%<25,F5-25,F5-(F5*5%)) Changed on 13/10/2012 to adapt for Liberty
                        .Range("I" & I).Formula = "=IF(F" & I & "*" & P_RESCOMM & "<" & A_MINLFEE & ",F" & I & "-1*" & A_MINLFEE & ",F" & I & "-(F" & I & "*" & P_RESCOMM & "))"
                    Else
                        '---> Col I  =IF(F5*1.85%<25,F5-30,F5-(F5*1.85%)-5) Changed on 23/11/2011
                        .Range("I" & I).Formula = "=IF(F" & I & "*" & P_LOADFEE & "<" & A_MINLFEE & ",F" & I & "-1*(" & A_MINLFEE & "+" & A_WIREFEE & "),F" & I & "-(F" & I & "*" & P_LOADFEE & ")-" & A_WIREFEE & ")"
                    End If
                    
                    Application.ScreenUpdating = True
                 End If
             End With
       End If
    End If
    'Application.EnableEvents = True
    Exit Sub
err:
    If err.Number <> 13 Then MsgBox err.Description
    'Application.EnableEvents = True

End Sub

Open in new window


6) SAVE and Exit the workbook.
7) Open the workbook and make sure you have all kind of emails in your monitoring outlook folder (Payment Recevied, Transfers and Liberty Emails)
8) Give the routine a try (Import Emails into Tabs) and check if all data updated correctly.

Pls advise your feedback.
Rgds/gowflow
Any chance to hv checked it out ?
gowflow
Avatar of JaseSt

ASKER

going to check it out today. got a LR email that I can test it with this morning. I'll let you know shortly
Avatar of JaseSt

ASKER

Results:

Correctly imported Payment Received wire, so no issues I can see there.

For LR wire:

1. It imported to the correct sheet
2. However, the calculation in Col i is incorrect. You have the calculation as .005. That is .5%. It needs to be 5%

So instead of formula for Col i:
=IF(F22*0.005<25,F22-1*25,F22-(F22*0.005))

please use this instead:
 =IF(F3*5%<25,F3-25,F3-(F3*5%))

Also, by the screenshot you can see Col N did not format correctly. Can you force the format to show the number rather than in scientific notation?

Another point I just saw. The date in Col K shows 10/18/12 as the first date. It needs to calculate the first date in Col K based on the criteria for Payment Received emails. If you need a reminder of that, let me know.

Almost there!User generated image
Re the 5% as you know we have established variables in Main and all min commission etc are picked up from there what is the 5% standing for ?? should we create a new variable ??
for col N if you increase the width of the cilumn you will see that the number will display correctly I can change this by code.

For the date what do you mean
The date in Col K shows 10/18/12 as the first date. ??????
Look at the screenshot you posted it shows 10/17/2012 as first date !!!!

gowflow
Avatar of JaseSt

ASKER

Yes, I guess you need to establish a new variable.

For the date, that is a complicated logic that I was hoping you'd remember so I wouldn't have to explain, but here it goes:

The first date inserted in Col K is the date of the email in the same row as the imported data.

The second date below that date in Col K (where the amount is broken up in no more than $2,000 increments), is:

1. Today's date UNLESS the last date in MC Consolidated Col J OR the last date in Col K is today's date OR if today's date is Saturday or Sunday.

IF today's date is the last date in either Col, then insert tomorrow's date in Col K, but it can't be Saturday or Sunday

I'm trying not to be too wordy. Does the above make sense?
YOU DID NOT READ MY POST !!!!!
I know the logic for the date and did not changed it !!!!

You mentioned the first date is 18/10 if you look at your snapshot it is not 18/10 it is 17/10 which is the email date and then it is broken into 2000 and the next 2000 has 18/10 !!!
check it again please.

Now for the new variable what is the name of it what do you want it to show in Main with the other variables ??
gowflow
Avatar of JaseSt

ASKER

LR Loading Fee
LR Loading Fee = 5% ???

what about the date is it fixed or still an issue ?
Dear JaseSt,

ok here it is:

1) Make a copy of your latest MC file and give it a new name.
2) Open the new workbook and goto vba and doubleclick on module1
3) click on bottom left icon to view 1 sub at a time.
4) display the following subs/functions and delete all of them
ImportData5new
FillRowFormulas
FillRowFormulasHMF

5) Paste the below code after any end sub

Sub FillRowFormulas(WS As Worksheet, Target As Range)
Dim P_LRLOADFEE As Double
Dim P_LOADFEE As Double
Dim P_RESCOMM As Double
Dim A_MINLFEE As Double
Dim A_WIREFEE As Double

With wsMain
    P_LRLOADFEE = .Range("I19")
    P_LOADFEE = .Range("I20")
    P_RESCOMM = .Range("I21")
    A_MINLFEE = .Range("I22")
    A_WIREFEE = .Range("I23")
End With

    'Application.EnableEvents = False
    On Error GoTo err
    'Set ws = ActiveSheet
    If UCase(Left(Trim(WS.Name), 11)) <> "HMF ACCOUNT" And _
       UCase(Left(Trim(WS.Name), 2)) <> "MC" And _
       UCase(Trim(WS.Name)) <> "MAIN" And _
       UCase(Trim(WS.Name)) <> "FINAL REPORT" And _
       UCase(Trim(WS.Name)) <> "SUMMARY" Then
       If Not Intersect(Target, WS.Columns(6)) Is Nothing And Len(Trim(Target.Value)) <> 0 Then
            With Sheets(WS.Name)
                I = Target.Row
                If IsNumeric(.Cells(I, 6).Value) Then
                    Application.ScreenUpdating = False
                    If .Range("G" & I).Value = "" Then
                        .Range("G" & I).Value = "EP " & Format(Date, "mm/dd/yy")
                    End If
                    
                    .Range("K" & I).Value = Date
                    .Range("K" & I).NumberFormat = "mm/dd/yy"
                    
                    Select Case UCase(Left(LTrim(WS.Name), 3))
                        Case "HMF", "OS " '=IF(F5*1.85%<25,F5-30,F5-(F5*1.35%)-5)
                            '.Range("I" & I).Formula = "=IF(F" & I & "*" & P_LOADFEE & "<" & A_MINLFEE & ",F" & I & "-1*(" & A_MINLFEE & ",F" & "+" & A_WIREFEE & "),F" & I & "-(F" & I & "*(" & P_LOADFEE & "-" & P_RESCOMM & ")-" & A_WIREFEE & ")"
                            
                            'Col L Formulas: =(F2-I2)-(F2*0.5%)
                            '.Range("L" & I).Formula = "=(F" & I & "-I" & I & ") - (F" & I & " * 0.5%)"
                            
                            'Col L New Formulas: =(F2-I2)*73% Changed on 23/11/2011
                            .Range("L" & I).Formula = "=(F" & I & "-I" & I & ")*(" & P_LOADFEE & " - " & P_RESCOMM & ") / " & P_LOADFEE
                            
                            'Col M Formulas: =0.5%*F2
                            '.Range("M" & I).Formula = "=(F" & I & "*" & P_RESCOMM & ")"
                            
                            'Col M New Formulas: =(F2-I2)*27% Changed on 23/11/2011
                            .Range("M" & I).Formula = "=(F" & I & "-I" & I & ")*(1-(" & P_LOADFEE & " - " & P_RESCOMM & ") / " & P_LOADFEE & ")"
                            
                        Case Else
                            'Col L  =F2-I2
                            .Range("L" & I).Formula = "=F" & I & "-I" & I
                            
                    End Select
                    'Cancelled old Formula on 23/11/2011
                    '.Range("I" & I).Formula = "=IF(F" & I & "*1.85%<25,F" & I & "-30,F" & I & "-(F" & I & "*1.85%)-5)"
                    
                    If Left(.Range("G" & I).Value, 2) = "LR" Then
                        '---> Col I  =IF(F5*5%<25,F5-25,F5-(F5*5%)) Changed on 13/10/2012 to adapt for Liberty
                        .Range("I" & I).Formula = "=IF(F" & I & "*" & P_LRLOADFEE & "<" & A_MINLFEE & ",F" & I & "-1*" & A_MINLFEE & ",F" & I & "-(F" & I & "*" & P_LRLOADFEE & "))"
                    Else
                        '---> Col I  =IF(F5*1.85%<25,F5-30,F5-(F5*1.85%)-5) Changed on 23/11/2011
                        .Range("I" & I).Formula = "=IF(F" & I & "*" & P_LOADFEE & "<" & A_MINLFEE & ",F" & I & "-1*(" & A_MINLFEE & "+" & A_WIREFEE & "),F" & I & "-(F" & I & "*" & P_LOADFEE & ")-" & A_WIREFEE & ")"
                    End If
                    
                    Application.ScreenUpdating = True
                 End If
             End With
       End If
    End If
    'Application.EnableEvents = True
    Exit Sub
err:
    If err.Number <> 13 Then MsgBox err.Description
    'Application.EnableEvents = True

End Sub


Sub FillRowFormulasHMF(WS As Worksheet, Target As Range)
Dim P_LRLOADFEE As Double
Dim P_LOADFEE As Double
Dim P_RESCOMM As Double
Dim A_MINLFEE As Double
Dim A_WIREFEE As Double

With wsMain
    P_LRLOADFEE = .Range("I19")
    P_LOADFEE = .Range("I20")
    P_RESCOMM = .Range("I21")
    A_MINLFEE = .Range("I22")
    A_WIREFEE = .Range("I23")
End With

    'Application.EnableEvents = False
    On Error GoTo err
    'Set ws = ActiveSheet
    If UCase(Left(Trim(WS.Name), 11)) = "HMF ACCOUNT" Then
       If Not Intersect(Target, WS.Columns(5)) Is Nothing And Len(Trim(Target.Value)) <> 0 Then
            With Sheets(WS.Name)
                I = Target.Row
                If IsNumeric(.Cells(I, 5).Value) Then
                    Application.ScreenUpdating = False
                    
                    'Col G Formulas: =E2*1.85%
                    '.Range("G" & I).Formula = "=E" & I & " * 1.85%"
                    
                    'Col G New Formula: =IF(E2*1.85%<25,25,E2*1.85%) Dated 23/11/2011
                    .Range("G" & I).Formula = "=IF(E" & I & "*" & P_LOADFEE & "<" & A_MINLFEE & "," & A_MINLFEE & ",E" & I & "*" & P_LOADFEE & ")"
                    
                    'Col H New Formula: =H2+F3-G3-J3 Dated 23/11/2011
                    .Range("H" & I).Formula = "=H" & I - 1 & "+F" & I & "-G" & I & "-J" & I
                    
                    'Col I Formulas: =E2-G2
                    .Range("I" & I).Formula = "=E" & I & "-G" & I
                    
                    
                    'Col K = Today;s date
                    .Range("K" & I).Value = Date
                    .Range("K" & I).NumberFormat = "mm/dd/yy"
                            
                    'Col L Formulas: =E2*1.35%
                    '.Range("L" & I).Formula = "=(E" & I & " * 1.35%)"
                    
                    'Col L New Formula: =G2*73% Dated 23/11/2011
                    .Range("L" & I).Formula = "=G" & I & "*(" & P_LOADFEE & "-" & P_RESCOMM & ")/" & P_LOADFEE
                    
                    'Col M Formulas: =M1+(F2*0.5%)
                    'If .Range("E" & I) <> 0 Or .Range("I" & I) <> 0 Then
                    '    .Range("M" & I).Formula = "=M" & I - 1 & " + (F" & I & " * 0.5%)"
                    'End If
                    'Col M Formulas: =G2-L2
                    .Range("M" & I).Formula = "=G" & I & " - L" & I
                    
                    Application.ScreenUpdating = True
                 End If
             End With
       End If
    End If
    'Application.EnableEvents = True
    Exit Sub
err:
    If err.Number <> 13 Then MsgBox err.Description
    'Application.EnableEvents = True

End Sub


Function ImportData5New(Body As String, ByVal RDate As Date, Row As Long, EmailType As String) As String
On Error GoTo Errhandler25
Dim WS As Worksheet
Dim CC As String
Dim CName As String
Dim Cur As String
Dim Amt As Double
Dim tmp As String
Dim sBatch As String
Dim sMemo As String
Dim sAccount As String
Dim Ifmacct As Integer
Dim MaxRow As Long, MaxRowH As Long
Dim P_LRLOADFEE As Double
Dim P_LOADFEE As Double
Dim P_RESCOMM As Double
Dim A_MINLFEE As Double
Dim A_WIREFEE As Double

With wsMain
    P_LRLOADFEE = .Range("I19")
    P_LOADFEE = .Range("I20")
    P_RESCOMM = .Range("I21")
    A_MINLFEE = .Range("I22")
    A_WIREFEE = .Range("I23")
End With

tmpa = Split(Body, Chr(10))

For I = 0 To UBound(tmpa)
    
    '---> Find CC and CName
    If EmailType = "Liberty" Then
        st = InStr(1, tmpa(I), "From Account:", vbTextCompare)
        Ifmacct = 14
    Else
        st = InStr(1, tmpa(I), "From:", vbTextCompare)
        Ifmacct = 6
    End If
    
    If st <> 0 Then
        If Not IsNumeric(Mid(tmpa(I), st + Ifmacct, 1)) Or Mid(tmpa(I), st + Ifmacct, 1) <> "5" Then
            If IsNumeric(Mid(tmpa(I), st + Ifmacct, 1)) Then
                ImportData5New = Mid(tmpa(I), st + Ifmacct)
                Exit Function
            Else
                '---> Disabled the Exit Function to Trap MCR and HMF Emails
                ImportData5New = Mid(tmpa(I), st + Ifmacct)
                
                '---> Extra Manipulation for Liberty Emails, Extract Account and CName
                If EmailType = "Liberty" Then
                    st = InStr(1, ImportData5New, " ", vbTextCompare)
                    If st <> 0 Then sAccount = Left(ImportData5New, st - 1)
                    st = InStr(1, ImportData5New, "(", vbTextCompare)
                    If st <> 0 Then
                        CName = Mid(ImportData5New, st + 1, Len(ImportData5New) - st - 2)
                    End If
                    ImportData5New = ""
                End If
            End If
        Else
            tmpb = Split(Mid(tmpa(I), st + Ifmacct, InStr(st, tmpa(I), Chr(13), vbBinaryCompare)), " ")
            For J = 0 To UBound(tmpb)
                If IsNumeric(tmpb(J)) Then
                    CC = CC & tmpb(J)
                Else
                    Exit For
                End If
            Next J
            
            For K = J To UBound(tmpb)
                CName = CName & tmpb(K) & " "
            Next K
            CName = RTrim(CName)
        End If
    End If
    
    '--> Find Curency, Amt
    st = InStr(1, tmpa(I), "Amount:", vbTextCompare)
    If st <> 0 Then
        tmpb = Split(Mid(tmpa(I), st + 8, InStr(st, tmpa(I), Chr(13), vbBinaryCompare)), " ")
        If EmailType <> "Liberty" Then
            If UBound(tmpb) = 1 Then
                Cur = tmpb(0)
                Amt = tmpb(1)
            End If
        Else
            If UBound(tmpb) = 0 Then
                If Left(tmpb(0), 1) = "$" Then
                    Cur = Left(tmpb(0), 1)
                    Amt = tmpb(0)
                Else
                    Amt = tmpb(0)
                End If
            Else
                Cur = tmpb(0)
                Amt = tmpb(1)
            End If
        End If
    End If
    
    '--> Find Batch
    If EmailType = "Liberty" Then
        st = InStr(1, tmpa(I), "Batch:", vbTextCompare)
        If st <> 0 Then
            tmpb = Split(Mid(tmpa(I), st + 7, InStr(st, tmpa(I), Chr(13), vbBinaryCompare)), Chr(13))
            If UBound(tmpb) = 1 Then
                sBatch = tmpb(0)
            End If
        End If
    End If
    
    '--> Find Memo
    If EmailType = "Liberty" Then
        st = InStr(1, tmpa(I), "Memo:", vbTextCompare)
        If st <> 0 Then
            tmpb = Split(Mid(tmpa(I), st + 6, InStr(st, tmpa(I), Chr(13), vbBinaryCompare)), Chr(13))
            If UBound(tmpb) = 1 Then
                sMemo = tmpb(0)
            End If
        End If
    End If
Next I

'Save to Excel Tab
MsgBox ("looking for sheet to update")
If ImportData5New = "" Then
    
    '---> Added to distinguish handling of Liberty Emails v/s others
    If EmailType <> "Liberty" Then
        ShtName = FindExcelTab(CC, EmailType)
    Else
        ShtName = FindExcelTab(sAccount, EmailType)
    End If
Else
    If UCase(Mid(ImportData5New, 1, 3)) = "HMF" Then
        ShtName = "HMF Account"
    Else
        ShtName = "MCR " & ImportData5New
    End If
End If


'Application.ScreenUpdating = False
'Look for the sheet
FoundSheet = False
If ShtName <> "" And InStr(1, ShtName, Chr(13)) <> 0 Then ShtName = Trim(Left(ShtName, InStr(1, ShtName, Chr(13)) - 1))

For Each WS In ThisWorkbook.Worksheets
    If UCase(WS.Name) = UCase(ShtName) Then
        FoundSheet = True
        Exit For
    End If
Next WS

If FoundSheet = False Or ShtName = "" Then
    ImportData5New = "Sheet: " & CName & " Not Found"
    'Exit Function
Else

With Sheets(UCase(ShtName))
    .Activate
    '.UsedRange.Select
    MaxRow = .UsedRange.Rows.count + 1
    MaxRowH = .Range("H:H").Rows(.Range("H:H").Rows.count).End(xlUp).Row
    
    If ImportData5New = "" Then
        
        '---> Depending on Email Type process
        If EmailType <> "Liberty" Then
            .Cells(MaxRow, "F") = Amt
        Else
            .Cells(MaxRow, "G") = "LR " & Format(RDate, "mm/dd/yy")
            .Cells(MaxRow, "N") = Format(sBatch, "@")
            .Cells(MaxRow, "O") = sMemo
            .Cells(MaxRow, "F") = Amt
        End If
        
    Else
        .Cells(MaxRow, "A") = RDate
        .Cells(MaxRow, "F") = Amt
        If UCase(ShtName) <> "HMF ACCOUNT" Then
            If UCase(ShtName) <> "MCR FI2" Then
                'New Formula Col G =F2*1.35%  changed on 23/11/2011
                .Cells(MaxRow, "G").Formula = "=F" & MaxRow & "*(" & P_LOADFEE & "-" & P_RESCOMM & ")"
            Else
                'New Formula Col G =IF(F3*1.85%<25,30,(F3*1.85%)) Changed on 23/11/2011
                .Cells(MaxRow, "G").Formula = "=IF(F" & MaxRow & "*" & P_LOADFEE & "<" & A_MINLFEE & "," & A_MINLFEE & ",F" & "+" & A_WIREFEE & ",F" & MaxRow & "*" & P_LOADFEE
            
                'New Formula Col I  =F2-G2 Changed on 23/11/2011
                .Cells(MaxRow, "I").Formula = "=F" & MaxRow & "-G" & MaxRow
            End If
            'Old Formula
            '.Cells(MaxRow, "G").Formula = "=(F" & MaxRow & "*1.35%)"
        End If
        .Range("H" & MaxRowH & ":H" & MaxRow).FillDown
        .Range("H" & MaxRowH + 1 & ":H" & MaxRow).Interior.ColorIndex = 0
        
        'Added for Col H when there is a Deposit 23/11/2011
        .Range("H" & MaxRow).Formula = "=H" & MaxRow - 1 & "+F" & MaxRow & "-G" & MaxRow & "-J" & MaxRow & "-1*" & A_WIREFEE
        
        .Cells(MaxRow, "K") = DateValue(Now)
        If UCase(ShtName) <> "HMF ACCOUNT" Then
            .Cells(MaxRow, "L").Formula = "=G" & MaxRow
        End If
        .Range("A" & MaxRow & ":L" & MaxRow).Interior.ColorIndex = 4
   End If
    If CName = "" Then CName = ShtName
    wsMain.Range("L" & CRow) = "Import Data : <" & CName & " " & RDate
    CRow = CRow + 1
End With
    ImportData5New = ""

'Application.ScreenUpdating = True
'Application.EnableEvents = True

End If


Exit Function

Errhandler25:
MsgBox (Error(err))
wsMain.Range("L" & CRow) = "Import Data - Error: <" & Error(err) & "> Item " & CName & " " & RDate
CRow = CRow + 1

Resume Next

End Function

Open in new window


6) SAVE the workbook
7) Display sheet Main
8) put in the following Cells these data
H19 LR Loading Fee
I19  5%
Remove the previous outline and make it the new outline from H19 till I23 like in the below snapshot.

User generated image
9)SAVE and Exit the workbook.
10) Start the workbook and give it a try.

Pls let me know
gowflow
Any news ?
gowlfow
Avatar of JaseSt

ASKER

Hi gowflow, sorry for the delay. Just tried it and it worked great!
Only issue was that Col N still gave the value inserted as scientific notation. The value that is inserted in Col N is 'Batch' value. Other than that worked perfectly.
ASKER CERTIFIED SOLUTION
Avatar of Jacques Geday
Jacques Geday
Flag of Canada image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of JaseSt

ASKER

hmmm... I wonder why I didn't get an email notification that you uploaded a post? Sorry, I should have looked. I'll try this out in a minute and let you know.
Avatar of JaseSt

ASKER

Yep, works perfectly. Thank you, gowflow.

Now, the next situation I need your expert help on, if you are available and willing, is to take these Liberty Reserve wires (now inserted in the spreadsheet) and total them (much as we already do with the Mastercard wires and loading fees already) and insert these values (LR wire sent and loading fee assessed) into the 'totals' spreadsheet.

Let me know if you are willing to tackle this one and if so, I'll post the link to the question here.

Thanks again!