JaseSt
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
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-(
but instead:
=IF(F3*5%<25,F3-25,F3-(F3*
Fwd-Liberty-Reserve-Payment-Rece.msgFwd-Liberty-Reserve-Payment-Rece.msgFwd-Liberty-Reserve-Payment-Rece.msg
ASKER
Fwd: Liberty Reserve Payment Received
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
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
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.
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
gowflow
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
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
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?
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?
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.
ASKER
Maybe to conserve space in Col G we should put 'LR' and the date rather than Liberty Reserve.
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
tks gowflow
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%))
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*
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
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
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.
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
??? 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
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
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
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
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
gowflow
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
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!
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,
please use this instead:
=IF(F3*5%<25,F3-25,F3-(F3*
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!
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
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
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?
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
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
ASKER
LR Loading Fee
LR Loading Fee = 5% ???
what about the date is it fixed or still an issue ?
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
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.
9)SAVE and Exit the workbook.
10) Start the workbook and give it a try.
Pls let me know
gowflow
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
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.
9)SAVE and Exit the workbook.
10) Start the workbook and give it a try.
Pls let me know
gowflow
Any news ?
gowlfow
gowlfow
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.
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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.
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!
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!
ASKER
Here's the link to the new question, gowflow. Decided to post it now.
https://www.experts-exchange.com/questions/27916437/summing-LR-values-from-MC-workbook-and-adding-to-totals-spreadsheet.html
https://www.experts-exchange.com/questions/27916437/summing-LR-values-from-MC-workbook-and-adding-to-totals-spreadsheet.html
will the subject for these emails be:
Fwd: Liberty Reserve Payment Received
OR
Liberty Reserve Payment Received
???