Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

Adding to code created from previous questions

Posted on 2011-10-16
39
Medium Priority
?
277 Views
Last Modified: 2012-06-22
gowflow,

You'll recognize this as something very similar to what you did with the MasterCard workbook.

For the Visa spreadsheet just worked on in the previous question, when the import of
Western Union emails is done I would like a function to automatically do the
following (it can also do it by clicking a button, if that is easier and less problematic):

1. Open a new spreadsheet with the column headings as indicated in the WU Spreadsheet attached.

2. For each row Where there is no date in Col J in 'WU-Staging-FBME', in Col P of 'WU-Staging-FBME' input: 'Wutoday's date'. (Example: WuOct17-11)

3. For each row Where there is no date in Col J in 'WU-Staging-FBME', copy the values from Cols: a through p and paste into the new spreadsheet, including the yellow highlighted blank rows

4.Save the new spreadsheet as Wutoday's date (same value as Col P - Example: WuOct17-11)

5. Allow me to review the inported data on the new spreadsheet.

6. when I click ok to the review, open up a new email

7. Address the email to: otto.weber@offshoreagle.com

8. Subject: Wutoday's date (same value as Col P)

9. And attach the just created spreadsheet

10. Add this to the body of the email:

"Hi Joseph,

Attached is the pick up request for the day.
Please send me your outstanding balance with us as of today.

Thank you!

Michael"

11. Insert into Col J of 'WU-Staging-FBME', today's date WU-Example.xls
0
Comment
Question by:JaseSt
  • 21
  • 18
39 Comments
 
LVL 31

Expert Comment

by:gowflow
ID: 36978393
similar to pushtobook ?? if yes then also here need file/folder location ?
pls confirm or ellaborate
gowflow
0
 

Author Comment

by:JaseSt
ID: 36978936
yes, similar to pushbook

I need to save the newly created spreadsheet here:
C:\Users\Michael\Desktop\My Dropbox\Sovereign\WesterUnionSubmissions
0
 
LVL 31

Expert Comment

by:gowflow
ID: 36978953
well you should know my style by now .... you will decide where to save your file ...
gowflow
0
Visualize your virtual and backup environments

Create well-organized and polished visualizations of your virtual and backup environments when planning VMware vSphere, Microsoft Hyper-V or Veeam deployments. It helps you to gain better visibility and valuable business insights.

 

Author Comment

by:JaseSt
ID: 36978980
Ok, then what were you asking with: "if yes then also here need file/folder location ?"
0
 
LVL 31

Expert Comment

by:gowflow
ID: 36978997
I meant need to put the whole routine that will allow you to choose file/folder .... mmmm
gowflow
0
 

Author Comment

by:JaseSt
ID: 36979063
put it behind a button on the Main page I suppose
0
 
LVL 31

Expert Comment

by:gowflow
ID: 36979072
2 buttons, one to choose file/folder location one to activate the routine
gowflow
0
 

Author Comment

by:JaseSt
ID: 36979097
sure, sounds good.
0
 
LVL 31

Expert Comment

by:gowflow
ID: 36981125
Here it is

1) Save your latest version of the Visa file and give it a new name. We will call it your Production Workbook.
2) Open the file just created activate macros.
3) from with in the previous file press file/open and Open the attached file (make sure they both don't have the same name)
4) Press View Menu slect Arrange All and choose Vertical press ok you will have both workbook side by side.
5) press on Developper and choose Visual basic on the left pane you will see both workbooks Make sure to know which one is your production workbook and which one is the attached file. You will be copying from the attached file to your production file and not vice versa.
6) copy the below code in module1 (doubleclick on Module1 of your production file slect to view 1 sub at a time lower left icon) then after last line of the Declaration section paste the attached below code (SELECT ALL in the code window right click choose copy and paste in module1)

 
Sub WMFileCreate(WS As Worksheet)
Dim WSS As Worksheet
Dim NewWS As Worksheet
Dim MaxRow, I, J As Long
Dim NewWb As Workbook
Dim NewWorkB As String

If gstFolderWesternUnion = "" Then
    MsgBox ("You need to select a destination folder to store the western Union files created. Please go to Sheet 'Main' and select a folder before proceeding further.")
    Exit Sub
Else
    If MsgBox("This process will create a new workbook with all records in sheet 'WU-Staging-FBME' that have NO date in Col J." & Chr(10) & Chr(10) _
        & "Are you ready to start this process ?", vbQuestion + vbYesNo, "Western Union File") = vbYes Then
    
        Set NewWb = Workbooks.Add
        Set NewWS = NewWb.Sheets("Sheet1")
        NewWS.Name = "WU" & Format(Now, "mm-dd-yyyy")
        
        'Visa - WUSept9-11.xls'
        NewWb.SaveAs Filename:=gstFolderWesternUnion & "WU" & Format(Now, "Mmmd-yy") & ".xls", FileFormat:=xlExcel8
        NewWorkB = NewWb.Name
        
        J = 1
        MaxRow = WS.UsedRange.Rows.Count
        WS.UsedRange.AutoFilter Field:=10, Criteria1:="=" & ""
        For I = 1 To MaxRow
            If WS.Range(I & ":" & I).EntireRow.Hidden = False Then
                WS.Range("A" & I & ":P" & I).Copy NewWS.Cells(J, 1)
                J = J + 1
            End If
        Next I
        NewWS.Range("Q:Z").EntireColumn.Delete
        'WS.ShowAllData
        'WS.AutoFilterMode = False
        
        'processCC NewWS
           
        With NewWS.Columns("A:P")
           .EntireColumn.AutoFit
           .HorizontalAlignment = xlLeft
        End With
           
        Application.DisplayAlerts = False
        
        For Each WSS In NewWb.Worksheets
            If WSS.Name <> NewWS.Name Then WSS.Delete
        Next WSS
        
        
        NewWb.Save
        
        'Set NewWb = Nothing
        'Set NewWS = Nothing
        Application.DisplayAlerts = True
        
        'ws.Activate
        MsgBox ("Workbook: '" & NewWorkB & "' has been created successfully")
        
        If MsgBox("Are you ready to proceed with Email Creation and Update of 'WU-Staging-FBME' with today;s date in Col J ?", vbQuestion + vbYesNo, "Email Creation") = vbYes Then
            For I = 1 To MaxRow
                If WS.Range(I & ":" & I).EntireRow.Hidden = False Then
                    WS.Range("J" & I) = DateValue(Now)
                    WS.Range("P" & I) = "WU" & Format(Now, "Mmmdd-yy")
                    J = J + 1
                End If
            Next I
            WS.ShowAllData
            WS.AutoFilterMode = False
            SendEmail NewWb.FullName
        Else
            MsgBox ("Request Canceled by user, No Email created and Colj and P not updated in 'WU-Staging-FBME'")
        End If
    End If
End If
End Sub


Sub SendEmail(fName As String)
Dim wb As Workbook
Dim WS As Worksheet


Dim SendTo As String
Dim OutlookApp As Object
Dim MItem As Object
Dim subject_ As String
Dim attach_ As String


Application.DisplayAlerts = False

'Create Outlook
Set OutlookApp = CreateObject("Outlook.Application")

'Fill in Subject Details'
subject_ = "WU" & Format(Now, "Mmmd-yy")
attach_ = fName
SendTo = "otto.weber@offshoreagle"

'Create the Email
Set MItem = OutlookApp.CreateItem(0)
With MItem
  .To = SendTo
  .Subject = subject_
  .Attachments.Add (attach_)
  .Body = "Hi Joseph," & Chr(10) & Chr(10) _
    & "Attached is the pick up request for the day." & Chr(10) _
    & "Please send me your outstanding balance with us as of today." & Chr(10) & Chr(10) _
    & "Thank you." & Chr(10) & Chr(10) _
    & "Michael" & Chr(10) _
    & "Sovereign Gold Card Support" & Chr(10) _
    & "www.sovereigngoldcard.com"

  'Send the Email
  .Display
End With

'Clear Resources
Set MItem = Nothing
Set OutlookApp = Nothing

Application.DisplayAlerts = True
End Sub


Sub GetNewFolder()

gstFolderWesternUnion = GFolderName("Western Union File")

If gstFolderWesternUnion <> "" And Dir(gstFolderWesternUnion) <> "" Then
    
    'Update CommandButton1 caption to show Actual Folder in use
    Sheets("Main").CommandButton3.Caption = "Target Export Folder for PushToBook: <" & gstFolderWesternUnion & "> ... Activated"

Else
    MsgBox ("No Folder has been selected or the Folder does not exist, therefore data cannot be Exported" _
        & " until valid Folder has been selected." & Chr(10) & Chr(10) _
        & "Please press on the command bar to choose a Folder.")
    Sheets("Main").CommandButton3.Caption = "Browse"
    
    With Application
        .DisplayAlerts = True
        .EnableEvents = True
    End With
    
    Exit Sub
End If
End Sub

Function GFolderName(fol As String) As String
Dim vrtSelectedItem

With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = Application.ActiveWorkbook.Path
    .Title = "Please choose Folder location for: " & fol
    .InitialView = msoFileDialogViewDetails
    .Show
    
    
    For Each vrtSelectedItem In .SelectedItems
    GFolderName = vrtSelectedItem & "\"
    Next vrtSelectedItem
End With

Set vrtSelectedItem = Nothing

End Function

Open in new window


7) Still in module1 in the Declaration section after the line
Global gstFolderToTransfer As String
... add this line
Global gstFolderWesternUnion As String

8) SAVE your production workbook
9) Select the sub ImportWesternUnion() and in hte last line just before End Sub insert the following line so it will look like this
-----------
WMFileCreate WS
End Sub
-----------
10) SAVE Your production workbook
11) doubleclick on ThisWorkbook of your production workbook
12) Press on Edit Select All in the Menu and in the code right click and press Delete you will endup wit an empty code in Thisworkbook
13) Paste the below code in Thisworkbook that you just deleted. (SELECT ALL right click Choose COPY and paste in ThisWorkbook of your production file.)

 
Private Sub Workbook_Deactivate()
SaveSetting APP_CATEGORY, APPNAME, "FolderToMonitor", gstFolderToMonitor
SaveSetting APP_CATEGORY, APPNAME, "FolderToTransfer", gstFolderToTransfer
SaveSetting APP_CATEGORY, APPNAME, "FolderWesternUnion", gstFolderWesternUnion
End Sub

Private Sub Workbook_Open()
On Error GoTo errHandler

Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True

StartPGM = True
gstFolderToMonitor = GetSetting(APP_CATEGORY, APPNAME, "FolderToMonitor", vbNullString)
gstFolderToTransfer = GetSetting(APP_CATEGORY, APPNAME, "FolderToTransfer", vbNullString)
gstFolderWesternUnion = GetSetting(APP_CATEGORY, APPNAME, "FolderWesternUnion", vbNullString)

Set wsVisa = ThisWorkbook.Sheets("Wire-Staging-FBME")
Set wsMain = ThisWorkbook.Sheets("Main")

CRow = 1
wsMain.Range("L1:L1000").ClearContents
wsMain.Range("L" & CRow) = "Workbook Open - gstFolderToMonitor: " & gstFolderToMonitor
wsMain.Range("L" & CRow + 1) = "Workbook Open - gstFolderToTransfer: " & gstFolderToTransfer
wsMain.Range("L" & CRow + 2) = "Workbook Open - gstFolderWesternUnion: " & gstFolderWesternUnion
CRow = CRow + 3

wsVisa.Activate
wsMain.Activate
Exit Sub

errHandler:
If Err = 9 Then
    MsgBox ("One of the essential sheets are missing. Pls review and try again")
    End
Else
    MsgBox (Error(Err))
    wsMain.Range("L" & CRow) = "Workbook Open - Error: <" & Error(Err) & ">"
    CRow = CRow + 1

    Resume Next
End If

End Sub

Open in new window


14) SAVE your production workbook.
15) Doubleclick on the sheet MAIN in the left pane of your production file. Choose from the Edit Menu Select All then in the code right click Delete and you will endup with a blank page in the Main code window.
16) SELECT ALL from the below code and right click choose COPY and paste it in the Main Code of your production workbook.

 
Private Sub Combobox1_Change()
gstFolderToMonitor = ComboBox1.Text
If ComboBox1 <> "" And ComboBox2 <> "" Then
    CommandButton1.Enabled = True
Else
    CommandButton1.Enabled = False
End If
wsMain.Range("L" & CRow) = "Combo1 Change - " & gstFolderToMonitor
CRow = CRow + 1

End Sub

Private Sub ComboBox2_Change()
gstFolderToTransfer = ComboBox2.Text

If ComboBox1 <> "" And ComboBox2 <> "" Then
    CommandButton1.Enabled = True
Else
    CommandButton1.Enabled = False
End If
wsMain.Range("L" & CRow) = "Combo2 Change - " & gstFolderToTransfer
CRow = CRow + 1
End Sub

Private Sub CommandButton1_Click()
'GetEmails
LocateEmails
End Sub

Private Sub CommandButton2_Click()
ImportWesternUnion
End Sub

Private Sub Worksheet_Activate()
On Error GoTo ErrhandlerAct

If StartPGM Then
    FillCombo ComboBox1
    FillCombo ComboBox2
    
    gstFolderToMonitor = ComboBox1
    gstFolderToTransfer = ComboBox2
    
    If gstFolderToMonitor = "" Then
        MsgBox ("Please select a Folder to Monitor Emails")
    Else
        ComboBox1.Text = gstFolderToMonitor
    End If
    
    If gstFolderToTransfer = "" Then
        MsgBox ("Please select a Folder to Transfer Emails Imported")
    Else
        ComboBox2.Text = gstFolderToTransfer
    End If
    
    If ComboBox1 <> "" And ComboBox2 <> "" And gstFolderToMonitor <> "" And gstFolderToTransfer <> "" Then
        CommandButton1.Enabled = True
    Else
        CommandButton1.Enabled = False
    End If
    
    If gstFolderWesternUnion = vbNullString Then
        GetNewFolder
    Else
        Sheets("Main").CommandButton3.Caption = "Target Export Folder for Western Union: <" & gstFolderWesternUnion & "> ... Activated"
    End If
    
    wsMain.Range("L" & CRow) = "Main Activate - gstFolderToMonitor: " & gstFolderToMonitor
    wsMain.Range("L" & CRow + 1) = "Main Activate - gstFolderToTransfer: " & gstFolderToTransfer
    wsMain.Range("L" & CRow + 2) = "Main Activate - gstFolderWesternUnion: " & gstFolderWesternUnion
    CRow = CRow + 3
    StartPGM = False
End If

Exit Sub

ErrhandlerAct:
MsgBox (Error(Err))
Resume Next

End Sub

Open in new window


17) SAVE your Production workbook.
18) Goto to your Excel sheet and display in both windows sheet Main. Select Developper menu and make sure that for both windows the Design button is clicked.
19) Select the Red label in the present attached file and press shift while holding shift press on the Red button so they are both selected release the shift button and right click (make sure the mouse is over the button) and choose copy
20) click on your production workbook so it get the focus and move the existing buttons if they are there and paste the items you just copied after the transfer combobox like in the attached sheet.
21) click anywhere else in hte Main worksheet so it remove the focus from the command button.
22) doubleclick on the red command button and make sure that the code is:
----------------
Private Sub CommandButton3_Click()
GetNewFolder
End Sub
---------------
The commanbutton should be 3 if it is not then you need to tell me what it is and I will let you know what the change will be.
23) SAVE the production workbook and exit it
24) Exit the attached file without saving it.
25) Try the new production workbook and let me know your feedback.

gowflow
0
 

Author Comment

by:JaseSt
ID: 36981211
Wow! That's quite a chunk of work and code you just put in gowflow!
I'll get to it later today. Thanks. I'll let you know, probably tomorrow am, my time,
how it worked out.
0
 
LVL 31

Expert Comment

by:gowflow
ID: 36981897
No problem take your time
gowflow
0
 

Author Comment

by:JaseSt
ID: 36983681
I think I'm following and have done all the way to this direction:

"Select the Red label in the present attached file and press shift while holding shift press on the Red button so they are both selected release the shift button and right click (make sure the mouse is over the button) and choose copy"

What do you mean by Red label? and Red button?  Attached is what I have. VisaSpreadsheet17-2011 is my production workbook. I don't have a red anything. side by side
0
 
LVL 31

Expert Comment

by:gowflow
ID: 36983837
Sorry I forgot to attach the file here it is
gowflow
Visa-20111017.xlsm
0
 

Author Comment

by:JaseSt
ID: 36985542
It would be very helpful in your instructions to specifically name what file you're referring to. For example, when you state:
"Open the file just created activate macros.
3) from with in the previous file press file/open and Open the attached file (make sure they both don't have the same name)"

What file are you referring to when you say 'just created'? And what file do you mean when you state 'previous file'?
I understand what the 'production' file is. That is my current Visa file I saved with a new name. However, when you are referring to your file just attached, please state the name of it: Visa-20111017. If you are referring to any other file, please be clear.

What I have done thus far is copy the above code snippets and placed them in my production file. Is that correct ? Because it seems I do NOT need your Visa-20111017 file before point#17. Right? If I have done it correctly so far, then I think I can figure out which files you are referring to from 17 on.
0
 

Author Comment

by:JaseSt
ID: 36985743
Ok, it worked, so I must have done it correctly, however there are some issues that I will be getting back to you on. But overall, so far so good. Thank you!
0
 

Author Comment

by:JaseSt
ID: 36986488
The great thing is that it did exactly as requested, but here are some minor issues:

1. Often times the email batch imported highlights both the empty row AND the first row imported in yellow. Just need the empty row between the imported emails highlighted.

2. Even though a MTCN number was not brought in (the sender made a mistake) it still went on with the process of creating a spreadsheet and creating an email, attaching the incomplete spreadsheet. So I need to check it over first, fix any errors, then continue with the automatic process., if possible. Now if I click 'no' it stops the process completely.

3. When updating my production visa sheet, it inputs today's date in any blank cell in Col J and inputs the 'Wutoday's date' in any blank cell of Col P. I'd rather not have this as they are intended to be blank and I do have other rows that are blank by design. I would say update Col J and Col P with those values IF there is a value in Col D - the MTCN# column.

4, There must be values in cols A through G and Col M and WUtoday's date value in Col P before I can email the spreadsheet. And as mentioned, I really need to double check to make sure everything was imported correctly from the email before it gets sent to Jozsef.

Thank you!
0
 
LVL 31

Expert Comment

by:gowflow
ID: 36986762

1.  is related to the previous question correct ? it is not within this question. If correct then I need to know in what cases this happens like a sample of the emails or a snapshot so I can figure out why htis is happeneing. I recall it did happen with me but as we did this part sometime ago I forgot about it now.

2. What do you mean ?? there are no lines to export and then you got the Excel created ? I guess its correct will need to chk if no record to export then to message something and prevent the creation of excel and email. If this is not what you meant pls clarify.

3. I did that due to your request and was a aware when I saw the file in hand especially the first couple of 100 rows had noting in J and it went putting the date and exported them ... Will fix it so it update Col J and P if D has a value. HOWEVER
I remind you the intial post: Make an Excel file with all records that have no date in Col J, so now it will be No date in Col J + value in Col D (this should eliminate all the blank rows that you had there by design) your left now with one issue which is the yellow lines that have no value in Col J and no Value in Col D therefore they will not be imported !!!! I will modify the importwesternunion emails so I can trap these yellow lines so we can export them and identify them.

4. I know that when I designed it this was a challenge as you are prompt to continue with the export or stop and don't have time to check the file and make corrections. Let me think of a way to allow you for checking/fixing before generating the email.

gowflow
0
 

Author Comment

by:JaseSt
ID: 36987064
1. Yes, from previous question. I'll investigate it further and get back to you.

2. What I mean is that in place of 'MTCN#' one entry in an email had 'Amount' so the MTCN number was not brought over. (Of course. Why did they do that?) And, things like this will happen where data will not import because of the emailer's error.

3. Sounds good

4. Ok. Thank you.
0
 
LVL 31

Expert Comment

by:gowflow
ID: 36988526
2. now in this case the item will not be exported although it shows in the file with MTCN# empty unless if you post the number manually then it will be imported. Is it ok this way ?

gowflow
0
 

Author Comment

by:JaseSt
ID: 36989248
Yes, there will be times when I just have to import something manually, but where I'd like that to be done is BEFORE it creates the new spreadsheet - if possible. But of course, definitely before it is attached to an email
0
 
LVL 31

Expert Comment

by:gowflow
ID: 36989516

ok fine here it is (let me be careful this time !!!)

The way it work
We have now 3 steps and each one is independent of the other and is activated by a button. like in the pic below.
Step 1 - Import WU Emails
Step 2 - Generate WU file
Step 3 - Generate Email and Update 'WU-Staging-FBME'

 WU Buttons
When you run a step and it completes you can check the coresponding data and make corrections for the next step. When you run Step 1 it will import the data form Emails to 'WU-Staging-FBME' and stops there. You then go to the sheet and check all the missing items and update manually or delete whatever and once done you move to Step 2 that will Generate the file from the existing modified data in 'WU-Staging-FBME'. Once generated the procedure stops leaving the file gerated open for you to check that all is ok. You may do alterations modifications to this file and save it. Then when you activate Step 3 it will tell you that you have a pending file not emailed with its name and proceed to create the email and update 'WU-Staging-FBME'. and the circle is completed for you to start a new circle. There are checks that will prevent you from sending a same file twice by email as it will keep track of the last file sent.

Here is how to IMPLEMENT (will try to keep it simple and will not bother you with an attached file !!!

1) Save your latest Visa file onto a new name and open it.
2) goto developper Visual Basic and doubleclick on module1
3) Choose to view 1 sub at a time by clicking on the left lower icon
4) Select the following sub and delete
Sub ImportWesternUnion()
Sub WMFileCreate
5) SAVE the workbook
6) SELECT ALL from the below code right click in the code choose COPY and paste in module1 after any End Sub.

 
Sub ImportWesternUnion()
Dim WS As Worksheet
Dim objOutlook As Object
Dim rng As Range, RngCardHolder As Range
Dim arrRows() As String
Dim arrRow() As String
Dim elem As Variant
Dim FMonitor, FTransfer
Dim FoundDivider As Boolean, FirstItemInMail As Boolean, StartDivider As Boolean
Dim CardNumber As String, CardHolder As String, TmpCardHolder As String
Dim SenderEmail As String
Dim Divider As String
Dim I As Long, J As Long, K As Long, L As Long
Dim C, FirstAddress, Items
Dim TmpAmount As String
Dim Fields As String, Possibility As String
Dim LenItem As Long, ColJRow As Long, ColARow As Long


Set objOutlook = CreateObject("Outlook.application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set WS = Sheets("WU-Staging-FBME")


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

'Disabled in this procedure as user do not want to move emails.
'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'")
VisaItems.Sort "receivedtime", False

'Setting Value of I depending on last item in Col J
ColJRow = WS.Range("J:J").Rows(WS.Range("J:J").Rows.Count).End(xlUp).Row
ColARow = WS.Range("A:A").Rows(WS.Range("A:A").Rows.Count).End(xlUp).Row
WS.Range("D:D").NumberFormat = "@"

If ColARow = ColJRow Then
    I = 1
Else
    I = WS.Cells(ColARow, 1) + 1
End If

Application.EnableEvents = False

For Each VItem In VisaItems
    wsMain.Range("L" & CRow) = "Import Western Union - Items: " & I & " " & VItem.SenderEmailAddress & " " & VItem
    CRow = CRow + 1

    Set objMail = VItem
    ' use Instr here to check subject or body
    'MsgBox objMail.Subject
    Body = objMail.Body
    ETime = objMail.ReceivedTime
    CardNumber = ""
    FoundDivider = False
    StartDivider = False
    FirstItemInMail = True
    SenderEmail = objMail.SenderEmailAddress
    
    
    'Split Email address
    Select Case Trim(UCase(SenderEmail))
        Case "WHITE@SECURENYM.NET"
            CardHolder = "Jen" & Format(ETime, "mmddyy")
        Case "BLIZZARD1980@HOTMAIL.COM"
            CardHolder = "Adam" & Format(ETime, "mmddyy")
        Case "KONG@SECURENYM.NET"
            CardHolder = "Shawn" & Format(ETime, "mmddyy")
        Case "INFO@HOLMSENTREPRISES.COM"
            CardHolder = "Holms" & Format(ETime, "mmddyy")
        Case Else
            CardHolder = SenderEmail & Format(ETime, "mmddyy")
    End Select
    
    'Check to see if Combination CardHolder + Col C date already exist then increment CardHolder by 1
    With WS.Range("M:M")
        TmpCardHolder = CardHolder
        K = 2
        Do
            Set C = .Find(TmpCardHolder, LookIn:=xlValues, lookat:=xlPart)
            If Not C Is Nothing Then
                TmpCardHolder = CardHolder & "-" & Format(K)
                K = K + 1
            End If
        Loop Until C Is Nothing
        CardHolder = TmpCardHolder

    End With

    
    If InStr(1, UCase(Body), "MTCN", vbTextCompare) > 0 Then
        If rng Is Nothing Then
            Set rng = WS.Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
            rng.Offset(1, 0).EntireRow.Insert
            WS.Range(rng.Offset(0, -1), rng.Offset(0, 39)).Interior.ColorIndex = 6
            'Made to trap yellow lines for Export Email
            rng.Offset(0, 2).Value = " "
        Else
            rng.Offset(1, 0).EntireRow.Insert
            WS.Range(rng.Offset(1, -1), rng.Offset(1, 39)).Interior.ColorIndex = 6
            'Made to trap yellow lines for Export Email
            rng.Offset(1, 2).Value = " "
            Set rng = rng.Offset(1, 0)
        End If
        arrRows = Split(Body, vbCrLf, , vbTextCompare)
        For Each elem In arrRows
            
            If InStr(1, elem, "Ashleigh Walck") > 0 Then
                a = 1
            End If
    
            'Spot Card Number as 'CARD #'
            If InStr(1, UCase(elem), "CARD #", vbTextCompare) > 0 And CardNumber = "" Then
                CardNumber = Trim(Mid(elem, InStr(1, UCase(elem), "CARD #", vbTextCompare) + 6))
                If Not IsNumeric(CardNumber) Then
                    TmpCardNumber = ""
                    For J = 1 To Len(CardNumber)
                        If IsNumeric(Mid(CardNumber, J, 1)) Then TmpCardNumber = TmpCardNumber & Mid(CardNumber, J, 1)
                    Next J
                    CardNumber = TmpCardNumber
                End If
                'To prevent other routines to interact
                elem = ""
            End If
                
            'Spot when block does not have semicolumn as divider in semicolumn ':' or else use space ' '
            If Left(Trim(elem), 1) <> "-" And Left(Trim(elem), 1) <> "=" And Left(Trim(elem), 1) <> "*" And Trim(elem) <> "" Then
                If InStr(elem, ":") > 0 Then
                    If InStr(InStr(elem, ":") + 1, elem, ":") > 0 Then
                        Divider = " "
                    Else
                        Divider = ":"
                    End If
                Else
                    If InStr(elem, ";") > 0 Then
                        If InStr(InStr(elem, ";") + 1, elem, ";") > 0 Then
                            Divider = " "
                        Else
                            Divider = ";"
                        End If
                    Else
                        If InStr(elem, " ") > 0 Then
                            Divider = " "
                        Else
                            Divider = ""
                        End If
                    End If
                End If
            End If
                
            'Spot beginning of Items
            If Left(elem, 1) = "-" Or Left(elem, 1) = "=" Then
                FoundDivider = True
                StartDivider = True
            End If
            
            
            'Spot Dividers in semicolumn ':' or else use space ' '
            LenItem = 0
            Possibility = ""
            Fields = "MTCN|MTCN#|MCTN|MCTN#|MTCN #|MTC#|MTCN;"
            Items = Split(Fields, "|")
            For L = 0 To UBound(Items)
                If InStr(1, elem, Items(L), vbTextCompare) > 0 Then
                    If Len(Items(L)) > LenItem Then
                        Possibility = Items(L)
                        LenItem = Len(Items(L))
                    End If
                End If
            Next L
            If Possibility <> "" Then
                If Not FoundDivider Then FoundDivider = True
                If Divider = "" Then
                    Divider = " "
                    elem = Possibility & Divider & Mid(elem, Len(Possibility) + 1)
                End If
            End If
                
            If InStr(elem, Divider) > 0 And Divider <> "" Then
                arrRow = Split(elem, Divider)
                'Select Case Trim(UCase(CStr(arrRow(0))))
                '    Case "MTCN", "MTCN#", "MCTN", "MCTN#", "MTCN #", "MTC#", "MTCN;"
                '        If Not FoundDivider Then FoundDivider = True
                '
                'End Select
            
                
                If FoundDivider Then
                    'Delete Row if no values
                    If WS.Range(rng.Offset(0, -1), rng.Offset(0, 39)).Interior.ColorIndex <> 6 And rng.Offset(0, 0).Value = "" And rng.Offset(0, 2).Value = "" And rng.Offset(0, 3).Value = "" And rng.Offset(0, 5).Value = "" Then
                        RngDeletd = WS.Cells(rng.Row - 1, rng.Column).Address
                        WS.Range(rng.Row & ":" & rng.Row).EntireRow.Delete
                        Set rng = WS.Range(RngDeletd)
                        I = I - 1
                    End If
                    Set rng = rng.Offset(1, 0)
                    rng.Offset(0, 1) = Format(ETime, "dd mmm yyyy")
                    rng.Offset(0, -1) = I
                    rng.Offset(0, 11) = CardHolder
                    If FirstItemInMail Then
                        rng.Offset(0, 16) = CardNumber
                        If Left(CardNumber, 1) = "4" Then rng.Offset(0, 17) = "EUR"
                        If Left(CardNumber, 1) = "5" Then rng.Offset(0, 17) = "USD"
                        FirstItemInMail = False
                    End If
                    wsMain.Range("L" & CRow) = "    Item: " & I & " " & VItem.SenderEmailAddress
                    CRow = CRow + 1
                    I = I + 1
                    FoundDivider = False
                End If
                
                
                If Divider = " " And (CardNumber <> "" Or StartDivider = True) Then
                     X = UpdateItemFound(rng, elem)
                Else
                    Select Case Trim(UCase(CStr(arrRow(0))))
                        Case "MTCN", "MTCN#", "MCTN", "MCTN#", "MTCN #", "MTC#", "MTCN;"
                            'Fix to importing MCTN with all characters including leading and trailing zeros
                            If Trim(arrRow(1)) <> "" Then
                                rng.Offset(0, 2) = Trim(Format(arrRow(1), "@"))
                            Else
                                If UBound(arrRow) > 1 Then
                                    rng.Offset(0, 2) = Trim(Format(arrRow(2), "@"))
                                End If
                            End If
                        Case "RECEIVER", "RECIEVER INFO", "RECEIVER NAME", "RECIEVER", "RECEVIER", "RECIVER", "RCVR"
                            rng = Trim(arrRow(1))
                        Case "SENDER LOCATION", "LOCATION", "SENDER'S W.U. LOCATION", "SENDER'S W.U. LOCATION(CITY & STATE)", "SENDERS W.U. LOCATION", "SENDER'S W.U. LOCATION (CITY AND STATE)", "SENDER'S LOCATION", "SENDER INFO", "SENDER LOC ", "W U LOCATION", "SENDER WU LOCATION", "SEND LOC ", "SENDER LOC", "SENDER LOC", "SENDERS WU LOCATIONS", "SENDERS W.U'S LOCATION", "SENDERS W/U LOCATION", "ADDRESS", "SENDERS W.U. LOCATION", "SENDERS LOCATION", "SENDER WU LOCATION", "SENDER LOCATION SENT", "SENDER W/U LOCATION", "SENDER W.U. LOCATION", "W.U. LOCATION", "W/U LOCATION", "W.U. LOCTION", "SENDER LOC.", "AMT SENT", "SENT FROM", "WU LOCATION", "LOCATION.", "LOC.", "SENDING WU LOCATION", "CITY"
                            rng.Offset(0, 4) = Trim(arrRow(1))
                        Case "AMOUNT", "AMT", "AMOUNT SENT", "TOTAL", "TOTAL AMOUNT", "AOUNT", "MOUNT", "AMNT", "AMOUNT $"
                            'Fix to importing amount as a number formated as $currency with double digits and
                            'Red if negatives
                            If Not IsNumeric(arrRow(1)) Then
                                TmpAmount = ""
                                For J = 1 To Len(elem)
                                    If IsNumeric(Mid(elem, J, 1)) Or Mid(elem, J, 1) = "." Then TmpAmount = TmpAmount & Mid(elem, J, 1)
                                Next J
                                arrRow(1) = TmpAmount
                            End If
                            If arrRow(1) <> "" Then rng.Offset(0, 5) = CDbl(arrRow(1))
                            rng.Offset(0, 5).NumberFormat = "$#,##0.00;[Red]($#,##0.00)"
                        Case "SENDER", "ENDER"
                            rng.Offset(0, 3) = Trim(arrRow(1))
                        Case Else
                    End Select
                    
                End If
            End If
            
        Next elem
    End If

Next VItem

Application.EnableEvents = True

'WS.UsedRange.EntireColumn.AutoFit
X = MsgBox("Total of " & I & " Western Union detailed transfer imported successfully." & Chr(10) _
    & "Please check data in sheet 'WU-Staging-FBME' and make necessary corrections if any before proceeding to Step 2 - [Generate WU File]", vbInformation, "Step 1 - Import WU Emails")

End Sub


Sub WMFileCreate(WS As Worksheet)
Dim WSS As Worksheet
Dim NewWS As Worksheet
Dim MaxRow As Long, I As Long, J As Long
Dim NewWb As Workbook
Dim NewWorkB As String
Dim X

If gstFolderWesternUnion = "" Then
    MsgBox ("You need to select a destination folder to store the western Union files created. Please go to Sheet 'Main' and select a folder before proceeding further.")
    Exit Sub
Else
    If MsgBox("This process will create a new workbook with all records in sheet 'WU-Staging-FBME' that have NO date in Col J." & Chr(10) & Chr(10) _
        & "Are you ready to start this process ?", vbQuestion + vbYesNo, "Step 2 - Generate WU File ") = vbYes Then
        
        J = 1
        'First Criteria Col J = ''
        WS.UsedRange.AutoFilter Field:=10, Criteria1:="=" & ""
        'Second Criteria Col D <>''
        WS.UsedRange.AutoFilter Field:=4, Criteria1:="=" & "*"
        MaxRow = WS.UsedRange.Rows.Count
        
        Set NewWb = Workbooks.Add
        Set NewWS = NewWb.Sheets("Sheet1")
        NewWS.Name = "WU" & Format(Now, "mm-dd-yyyy")
        
        'Visa - WUSept9-11.xls'
        NewWb.SaveAs Filename:=gstFolderWesternUnion & "WU" & Format(Now, "Mmmd-yy") & ".xls", FileFormat:=xlExcel8
        NewWorkB = NewWb.Name
    
        For I = 1 To MaxRow
            If WS.Range(I & ":" & I).EntireRow.Hidden = False Then
                WS.Range("A" & I & ":P" & I).Copy NewWS.Cells(J, 1)
                J = J + 1
            End If
        Next I
        NewWS.Range("Q:Z").EntireColumn.Delete
        'WS.ShowAllData
        'WS.AutoFilterMode = False
        
        'processCC NewWS
           
        With NewWS.Columns("A:P")
           .EntireColumn.AutoFit
           .HorizontalAlignment = xlLeft
        End With
           
        Application.DisplayAlerts = False
        
        For Each WSS In NewWb.Worksheets
            If WSS.Name <> NewWS.Name Then WSS.Delete
        Next WSS
        
        
        NewWb.Save
        
        Application.DisplayAlerts = True
        MaxRow = NewWS.UsedRange.Rows.Count
        
        If MaxRow > 2 Then
            gstGenerateWUName = NewWb.FullName
            gstGenerateWUEmail = ""
            X = MsgBox("Workbook: '" & NewWorkB & "' has been created successfully. Please check workbook to ensure all data is accurate. After all modifications done please ensure file is saved to proceed to Next Step 3 - [ Generate Email & Update 'WU-Staging-FBME']", vbInformation, "Step 2 - Generate WU File")
        Else
            Application.DisplayAlerts = False
            Kill NewWb.FullName
            Application.DisplayAlerts = True
            gstGenerateWUName = ""
            gstGenerateWUEmail = ""
            MsgBox ("No Records were found ! nothing to Export.")
        End If
        WS.ShowAllData
        WS.AutoFilterMode = False
    End If
End If
End Sub


Sub WUEmailCreate(WS As Worksheet, NewWorkB As String)
Dim NewWb As Workbook
Dim NewWS As Worksheet
Dim MaxRow As Long, I As Long, J As Long


If MsgBox("Are you ready to proceed with Email Creation for file '" & NewWorkB & "' and Update sheet 'WU-Staging-FBME' with today's date in Col J ?", vbQuestion + vbYesNo, "Step 3 - Generate Email & Update 'WU-Staging-FBME'") = vbYes Then
            
    Set NewWb = Workbooks.Open(NewWorkB)
    Set NewWS = ActiveSheet
    
    J = 1
    'First Criteria Col J = ''
    WS.UsedRange.AutoFilter Field:=10, Criteria1:="=" & ""
    'Second Criteria Col D <>''
    WS.UsedRange.AutoFilter Field:=4, Criteria1:="=" & "*"
    MaxRow = WS.UsedRange.Rows.Count
        
    For I = 2 To MaxRow
        If WS.Range(I & ":" & I).EntireRow.Hidden = False Then
            WS.Range("J" & I) = DateValue(Now)
            WS.Range("P" & I) = "WU" & Format(Now, "Mmmdd-yy")
            J = J + 1
        End If
    Next I
    WS.ShowAllData
    WS.AutoFilterMode = False
    SendEmail NewWb.FullName
    gstGenerateWUEmail = NewWb.FullName
Else
    MsgBox ("Request Canceled by user, No Email created and Col J and P not updated in 'WU-Staging-FBME'")
End If
End Sub

Open in new window


7) SAVE the workbook
8) In module1 on the right top combobox select the first item Declaration select all the declaration section and delete the code. Once deleted it will display the first Sub. Click again on the right top combobox and select again Declaration you will see a white page. Paste the below code in this white page

 
Global Const APP_CATEGORY = "Software JG"
Global Const APPNAME = "ImportEmails"
Global wsVisa As Worksheet
Global wsMain As Worksheet

Global myolApp As Outlook.Application
Global gstFolderToMonitor As String
Global gstFolderToTransfer As String
Global gstFolderWesternUnion As String
Global gstGenerateWUName As String
Global gstGenerateWUEmail As String
Global objOutlook As New Outlook.Application
Global objNameSpace As Outlook.Namespace
Global objFolders As Outlook.Folders
Global objFolder As MAPIFolder
Global InboxFolder As MAPIFolder

Global objFolderToMonitor As MAPIFolder
Global objFolderToTransfer As MAPIFolder

Global VisaItems As Outlook.Items
Global objMail As Outlook.MailItem
Global StartPGM As Boolean
Global CRow As Long

Open in new window


9) SAVE the workbook.
10) Doubleclick on Thisworkbook in the left pane and select all the code there (edit/select all) and delete the code there and paste the below code in the white area.

 
Private Sub Workbook_Deactivate() 'gstGenerateWUName
SaveSetting APP_CATEGORY, APPNAME, "FolderToMonitor", gstFolderToMonitor
SaveSetting APP_CATEGORY, APPNAME, "FolderToTransfer", gstFolderToTransfer
SaveSetting APP_CATEGORY, APPNAME, "FolderWesternUnion", gstFolderWesternUnion
SaveSetting APP_CATEGORY, APPNAME, "GenerateWUName", gstGenerateWUName
SaveSetting APP_CATEGORY, APPNAME, "GenerateWUEmail", gstGenerateWUEmail
End Sub

Private Sub Workbook_Open()
On Error GoTo errHandler

Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True

StartPGM = True
gstFolderToMonitor = GetSetting(APP_CATEGORY, APPNAME, "FolderToMonitor", vbNullString)
gstFolderToTransfer = GetSetting(APP_CATEGORY, APPNAME, "FolderToTransfer", vbNullString)
gstFolderWesternUnion = GetSetting(APP_CATEGORY, APPNAME, "FolderWesternUnion", vbNullString)
gstGenerateWUName = GetSetting(APP_CATEGORY, APPNAME, "GenerateWUName", vbNullString)
gstGenerateWUEmail = GetSetting(APP_CATEGORY, APPNAME, "GenerateWUEmail", vbNullString)


Set wsVisa = ThisWorkbook.Sheets("Wire-Staging-FBME")
Set wsMain = ThisWorkbook.Sheets("Main")

CRow = 1
wsMain.Range("L1:L1000").ClearContents
wsMain.Range("L" & CRow) = "Workbook Open - gstFolderToMonitor: " & gstFolderToMonitor
wsMain.Range("L" & CRow + 1) = "Workbook Open - gstFolderToTransfer: " & gstFolderToTransfer
wsMain.Range("L" & CRow + 2) = "Workbook Open - gstFolderWesternUnion: " & gstFolderWesternUnion
wsMain.Range("L" & CRow + 3) = "Workbook Open - Last GenerateWUName: " & gstGenerateWUName
wsMain.Range("L" & CRow + 4) = "Workbook Open - Last GenerateWUEmail: " & gstGenerateWUEmail
CRow = CRow + 5

wsVisa.Activate
wsMain.Activate
Exit Sub

errHandler:
If Err = 9 Then
    MsgBox ("One of the essential sheets are missing. Pls review and try again")
    End
Else
    MsgBox (Error(Err))
    wsMain.Range("L" & CRow) = "Workbook Open - Error: <" & Error(Err) & ">"
    CRow = CRow + 1

    Resume Next
End If

End Sub

Open in new window


11) SAVE the workbook
12) Doubleclick on Main and select the whole code and delete it and paste in the white area the below code.

 
Private Sub Combobox1_Change()
gstFolderToMonitor = ComboBox1.Text
If ComboBox1 <> "" And ComboBox2 <> "" Then
    CommandButton1.Enabled = True
Else
    CommandButton1.Enabled = False
End If
wsMain.Range("L" & CRow) = "Combo1 Change - " & gstFolderToMonitor
CRow = CRow + 1

End Sub

Private Sub ComboBox2_Change()
gstFolderToTransfer = ComboBox2.Text

If ComboBox1 <> "" And ComboBox2 <> "" Then
    CommandButton1.Enabled = True
Else
    CommandButton1.Enabled = False
End If
wsMain.Range("L" & CRow) = "Combo2 Change - " & gstFolderToTransfer
CRow = CRow + 1
End Sub

Private Sub CommandButton1_Click()
'GetEmails
LocateEmails
End Sub

Private Sub CommandButton2_Click()
ImportWesternUnion
End Sub

Private Sub CommandButton3_Click()
GetNewFolder
End Sub

Private Sub CommandButton4_Click()
WMFileCreate Sheets("WU-Staging-FBME")
End Sub

Private Sub CommandButton5_Click()
If gstGenerateWUName = "" Then
    MsgBox ("You should Run command [Generate WU File] first, as no file has been generated yet.")
Else
    If gstGenerateWUName = gstGenerateWUEmail Then
        MsgBox ("File : '" & gstGenerateWUEmail & "' has already been emailed. You should Run command [Generate WU File] to create a new file.")
    Else
        If gstGenerateWUName <> "" And gstGenerateWUEmail = "" Then
            WUEmailCreate Sheets("WU-Staging-FBME"), gstGenerateWUName
        End If
    End If
End If
End Sub

Private Sub Worksheet_Activate()
On Error GoTo ErrhandlerAct

If StartPGM Then
    FillCombo ComboBox1
    FillCombo ComboBox2
    
    gstFolderToMonitor = ComboBox1
    gstFolderToTransfer = ComboBox2
    
    If gstFolderToMonitor = "" Then
        MsgBox ("Please select a Folder to Monitor Emails")
    Else
        ComboBox1.Text = gstFolderToMonitor
    End If
    
    If gstFolderToTransfer = "" Then
        MsgBox ("Please select a Folder to Transfer Emails Imported")
    Else
        ComboBox2.Text = gstFolderToTransfer
    End If
    
    If ComboBox1 <> "" And ComboBox2 <> "" And gstFolderToMonitor <> "" And gstFolderToTransfer <> "" Then
        CommandButton1.Enabled = True
    Else
        CommandButton1.Enabled = False
    End If
    
    If gstFolderWesternUnion = vbNullString Then
        GetNewFolder
    Else
        Sheets("Main").CommandButton3.Caption = "Target Export Folder for Western Union: <" & gstFolderWesternUnion & "> ... Activated"
    End If
    
    If gstGenerateWUName <> gstGenerateWUEmail Then
        MsgBox ("Please note that File : '" & gstGenerateWUName & "' has been created, however not Emailed." & Chr(10) & Chr(10) _
            & "You should proceed to select [Generate Email & Update 'WU-Staging-FBME'] button to Email the created file." & Chr(10) & Chr(10) _
            & "You may at any time, select [Generate WU File] to build a new file for Export")
    End If
    
    wsMain.Range("L" & CRow) = "Main Activate - gstFolderToMonitor: " & gstFolderToMonitor
    wsMain.Range("L" & CRow + 1) = "Main Activate - gstFolderToTransfer: " & gstFolderToTransfer
    wsMain.Range("L" & CRow + 2) = "Main Activate - gstFolderWesternUnion: " & gstFolderWesternUnion
    CRow = CRow + 3
    StartPGM = False
End If

Exit Sub

ErrhandlerAct:
MsgBox (Error(Err))
Resume Next

End Sub

Open in new window


13) SAVE the workbook
14) We need now to create 3 buttons like in the first attached image. to do this goto sheet Main make sure in menu developper the Design icon is clicked, then right click on the purple button called Western Union Imports choose copy and paste it twice there so you will have 3 buttons. Put the first button on top the next one created underneith and the last one at the end. Right click each one and select property and change their caption to fit the Image change also the color if you want to yellow (background) and don't forget to change the foreground to black it was initially white.
now make sure that
CommanButton2 is: 1 - Import WU Emails
CommanButton4 is: 2 - Generate WU File
CommanButton5 is: 3 - Generate Email & Update 'WU-Staging-FBME'
Once done SAVE the workbook

15) doubleclik on each button and make sure the below code is already there

 
Private Sub CommandButton2_Click()
ImportWesternUnion
End Sub

Private Sub CommandButton4_Click()
WMFileCreate Sheets("WU-Staging-FBME")
End Sub

Private Sub CommandButton5_Click()
If gstGenerateWUName = "" Then
    MsgBox ("You should Run command [Generate WU File] first, as no file has been generated yet.")
Else
    If gstGenerateWUName = gstGenerateWUEmail Then
        MsgBox ("File : '" & gstGenerateWUEmail & "' has already been emailed. You should Run command [Generate WU File] to create a new file.")
    Else
        If gstGenerateWUName <> "" And gstGenerateWUEmail = "" Then
            WUEmailCreate Sheets("WU-Staging-FBME"), gstGenerateWUName
        End If
    End If
End If
End Sub

Open in new window


16) SAVE the workbook EXIT start it again and try it

Let me know your comments.
gowflow
0
 

Author Comment

by:JaseSt
ID: 36989789
Seemed to work perfectly on a batch I had come in, except it did not input 'WuOct18-11" (for today's date) in Col P of the production spreadsheet nor in the created spreadsheet.
0
 

Author Comment

by:JaseSt
ID: 36989799
Hmmmm..... Maybe it did put in the WuOct18-11 after the email is created? But it still is putting values in the blank rows in Col J and P, which should remain blank.
0
 
LVL 31

Expert Comment

by:gowflow
ID: 36990782
Well when you activate stepp 3 this is where it updates Col J and P unfortunately you will have to live with the yellow columns beeing flaged in J and P although it does not make sence but also importing them to excel when they are blank also does not make sence so to be consequent and to have the file keep integrity you will have to choose:

Between
1) not importing the yellow line hence Col J and P will not be updated
and
2) Importing the yellow lines hence updating the date in Col J and P will be done

Rgds/gowflow
0
 

Author Comment

by:JaseSt
ID: 36992485
I think I can get around values being put in the blank rows by just putting some value in them before running the process. One thing it is not doing that needs to be done: With the created spreadsheet it is not imputting the WUToday'sDate value in Col P (and thus the emailed spreadsheet) maybe because it isn't inserting that value in the production spreadsheet before the new spreadsheet is created.
0
 
LVL 31

Expert Comment

by:gowflow
ID: 36994090
With the created spreadsheet it is not imputting the WUToday'sDate value in Col P (and thus the emailed spreadsheet)
>>> For sure it is not putting values in Col J and P Should it ??? Was under the impression htat only Via file should be updated wit the values.

I quote your post
3. For each row Where there is no date in Col J in 'WU-Staging-FBME', copy the values from Cols: a through p and paste into the new spreadsheet, including the yellow highlighted blank rows

no wher eit says: Import the rows that have no value in Col J and in the Excel spreadsheet created make the col J = today's date and Col P = WU + todays date . It only says:
2. For each row Where there is no date in Col J in 'WU-Staging-FBME', in Col P of 'WU-Staging-FBME' input: 'Wutoday's date'. (Example: WuOct17-11)

gowflow
0
 

Author Comment

by:JaseSt
ID: 36994208
Sorry, I'm not following your above post.

What I need to have is the newly created sheet (the sheet that is also emailed) have WUtoday'sDate inserted for all rows populated in Col P
0
 
LVL 31

Expert Comment

by:gowflow
ID: 36994227
what about Col J ? the date as well ?
gowflow
0
 

Author Comment

by:JaseSt
ID: 36994282
Col J does NOT get input into the created spreadsheet, only into the production sheet as Col J's purpose is to tell me that an email (the email created) was sent to Josef on the date indicated. So Col J in the created spreadsheet remains blank.  Thank you!
0
 
LVL 31

Expert Comment

by:gowflow
ID: 36994574
so to summ it up what are the problems remaining:
1) to put in Col P of the created spreadsheet WUtoday's date
2) Not to put anything in yellow columns in WU-Staging-FBME Col J and Col P

Anything else ?
I presume also Yellow lines in Excel created not to have a date in Col P right ?
pls confirm
gowflow
0
 

Author Comment

by:JaseSt
ID: 36994676
1. yes

2. Not to put anything in yellow ROWS or ANY empty row (empty could be defined as nothing in Col C.)

And yes, the yellow rows should contain nothing but yellow. No data.
0
 
LVL 31

Expert Comment

by:gowflow
ID: 36994909
Your story is definitvely challenging ! good common sence for yellow but not same logic when it comes to Export ... Export where there is data but also blank rows ... that are yellow and then put data where there is data but not the yellow ... anyway

Will see what I can come up with !! and for sure not matter what I do not accept as an answer ... if you can't do it don't worry forget about it .. I will do it manually !!! These kind of answers I take as an insult to my intelligence !

When I developp it it has to work EXACTLY like the customer wants ... or else it is not a solution !
gowflow
0
 

Author Comment

by:JaseSt
ID: 36995223
I appreciate your unwavering determination to excellence, gowflow. Any slight to your intelligence is completely unintended because I view you as a genius in this field, far above my capability to do what I'm hoping to have done - and I thank you for it.
0
 
LVL 31

Expert Comment

by:gowflow
ID: 36996313
wow am overwhelmed !!! no worry I don't mean any harm to oyur comments but sometimes - and its quite natural - not all people hv the same determination to acheive the desired result and I see this everyday in my work where my clients sometimes seeing that some issues are tough to be resolved say: its ok I'll do it manually anyway its not a big issue ...

One of them is:
The challenge we had and still ur having for the moving of emails (don't know for some reason we still bump on this one)
and also when we were coloring green and red and at some point seeing that it was getting green but not red u said ... don't worry as long as etc ...
etc ....
its these change of course due to difficulties (temeporary I call them) that make people quit or other change course that make me more amore resilient to find the solution !!!! Its like the pinch of adrenalin that keeps me going !!!

too much bla bla let me go back to producing !
gowflow
0
 
LVL 31

Accepted Solution

by:
gowflow earned 2000 total points
ID: 36996509
Here you go ... hopefully as u would like it !
1) save a new name for your latest visa file
2) Choose to view 1 sub at a time by clicking the bottom left icon
3) display module1 and delete
Sub WMFileCreate
Sub WUEmailCreate
3) SELECT ALL in the below code and choose right click COPYand paste in module1 after any End Sub
4) SAVE the workbook and Exit
5) Start and test

Pls let me know.
gowflow
Sub WMFileCreate(WS As Worksheet)
Dim WSS As Worksheet
Dim NewWS As Worksheet
Dim MaxRow As Long, I As Long, J As Long
Dim NewWb As Workbook
Dim NewWorkB As String
Dim X

If gstFolderWesternUnion = "" Then
    MsgBox ("You need to select a destination folder to store the western Union files created. Please go to Sheet 'Main' and select a folder before proceeding further.")
    Exit Sub
Else
    If MsgBox("This process will create a new workbook with all records in sheet 'WU-Staging-FBME' that have NO date in Col J." & Chr(10) & Chr(10) _
        & "Are you ready to start this process ?", vbQuestion + vbYesNo, "Step 2 - Generate WU File ") = vbYes Then
        
        J = 1
        'First Criteria Col J = ''
        WS.UsedRange.AutoFilter Field:=10, Criteria1:="=" & ""
        'Second Criteria Col D <>''
        WS.UsedRange.AutoFilter Field:=4, Criteria1:="=" & "*"
        MaxRow = WS.UsedRange.Rows.Count
        
        Set NewWb = Workbooks.Add
        Set NewWS = NewWb.Sheets("Sheet1")
        NewWS.Name = "WU" & Format(Now, "mm-dd-yyyy")
        
        'Visa - WUSept9-11.xls'
        NewWb.SaveAs Filename:=gstFolderWesternUnion & "WU" & Format(Now, "Mmmd-yy") & ".xls", FileFormat:=xlExcel8
        NewWorkB = NewWb.FullName
    
        For I = 1 To MaxRow
            If WS.Range(I & ":" & I).EntireRow.Hidden = False Then
                WS.Range("A" & I & ":P" & I).Copy NewWS.Cells(J, 1)
                If NewWS.Range("D" & J) <> "" And NewWS.Range("D" & J) <> " " And I <> 1 Then
                    NewWS.Range("P" & J) = "WU" & Format(Now, "Mmmdd-yy")
                End If
                J = J + 1
            End If
        Next I
        NewWS.Range("Q:Z").EntireColumn.Delete
        'WS.ShowAllData
        'WS.AutoFilterMode = False
        
        'processCC NewWS
           
        With NewWS.Columns("A:P")
           .EntireColumn.AutoFit
           .HorizontalAlignment = xlLeft
        End With
           
        Application.DisplayAlerts = False
        
        For Each WSS In NewWb.Worksheets
            If WSS.Name <> NewWS.Name Then WSS.Delete
        Next WSS
        
        
        NewWb.Save
        
        Application.DisplayAlerts = True
        MaxRow = NewWS.UsedRange.Rows.Count
        
        If MaxRow > 2 Then
            gstGenerateWUName = NewWb.FullName
            gstGenerateWUEmail = ""
            X = MsgBox("Workbook: '" & NewWorkB & "' has been created successfully. Please check workbook to ensure all data is accurate. After all modifications done please ensure file is saved to proceed to Next Step 3 - [ Generate Email & Update 'WU-Staging-FBME']", vbInformation, "Step 2 - Generate WU File")
        Else
            Application.DisplayAlerts = False
            NewWb.Close savechanges:=False
            Kill NewWorkB
            Application.DisplayAlerts = True
            gstGenerateWUName = ""
            gstGenerateWUEmail = ""
            MsgBox ("No Records were found ! nothing to Export.")
        End If
        WS.ShowAllData
        WS.AutoFilterMode = False
    End If
End If
End Sub


Sub WUEmailCreate(WS As Worksheet, NewWorkB As String)
Dim NewWb As Workbook
Dim NewWS As Worksheet
Dim MaxRow As Long, I As Long, J As Long


If MsgBox("Are you ready to proceed with Email Creation for file '" & NewWorkB & "' and Update sheet 'WU-Staging-FBME' with today's date in Col J ?", vbQuestion + vbYesNo, "Step 3 - Generate Email & Update 'WU-Staging-FBME'") = vbYes Then
            
    Set NewWb = Workbooks.Open(NewWorkB)
    Set NewWS = ActiveSheet
    
    J = 1
    'First Criteria Col J = ''
    WS.UsedRange.AutoFilter Field:=10, Criteria1:="=" & ""
    'Second Criteria Col D <>''
    WS.UsedRange.AutoFilter Field:=4, Criteria1:="=" & "*"
    MaxRow = WS.UsedRange.Rows.Count
        
    For I = 2 To MaxRow
        If WS.Range(I & ":" & I).EntireRow.Hidden = False Then
            If WS.Range("D" & I) <> "" And WS.Range("D" & I) <> " " Then
                WS.Range("J" & I) = DateValue(Now)
                WS.Range("P" & I) = "WU" & Format(Now, "Mmmdd-yy")
                J = J + 1
            Else
                WS.Range("J" & I) = Chr(13)
                J = J + 1
            End If
        End If
    Next I
    WS.ShowAllData
    WS.AutoFilterMode = False
    SendEmail NewWb.FullName
    gstGenerateWUEmail = NewWb.FullName
Else
    MsgBox ("Request Canceled by user, No Email created and Col J and P not updated in 'WU-Staging-FBME'")
End If
End Sub

Open in new window

0
 

Author Comment

by:JaseSt
ID: 36997670
Tried it once and seemed to work, however there was one strange changing of the value of an amount (the label was far from correct so maybe that caused it), but will test it again tomorrow and get back to you. Thank you
0
 
LVL 31

Expert Comment

by:gowflow
ID: 36999251
could be. ok will wait to see results of ur tests.
gowflow
0
 

Author Closing Comment

by:JaseSt
ID: 36999559
gowflow's the best. He nailed yet another!

we still have a number to go gowflow, if you're willing, continuing on with the next part to this Western Union process and also doing for the Visa email (highlighting the processed and unprocessed) as we did for the Mastercard emails - and it is that I will submit next to get it out of the way.
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

If you need to forecast numbers -- typically for finance -- the Windows and Mac versions of Excel 2016 have a basket of tools to get the job done.
A few solutions to a problem some of us have been having when trying to add Hostgator email accounts to Outlook 2016 (will probably work with Outlook 2013 as well).
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
Suggested Courses

580 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question