Posts by cbanks

cbanks · Apr 25th 2007

Re: Copying A Range From One Worksheet Into An Area In Another Workbook

Sry. Did not test.

Code

Sub Copy()
    Workbooks.Open Filename:= _
    "C:\TDocuments.xls"
    Workbooks("Book1.xls").Activate 'need to define email workbook name here
    Sheets("Email").Activate
    Range("L1:Q1").Select
    Selection.Copy
    Workbooks("TDocuments.xls").Activate
    intFreeRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
    Cells(intFreeRow, 1).PasteSpecial
    ActiveWorkbook.Save
End Sub

Display More

cbanks · Apr 25th 2007

Re: Copy And Paste Columns Based On Formula

Code

Sub MyCopyData()
     
    Dim mycell As Range
    Dim intFreeRow As Integer
    Const DateInterval As Byte = 14
     
    Application.ScreenUpdating = False
     
     ' Clear date of sheet Not attendent
    Sheets("Not Attended").Cells.ClearContents
     
     ' choose sheet Master Sheet
    Sheets("Master Sheet").Activate
     ' runing each cell in Column A(1)
    For Each mycell In Range("D3:D65536").Cells
         ' activecell is empty = Exit For
        If Len(mycell) = 0 Then Exit For
         ' compare Date - Interval
        If Date - DateInterval > mycell Then
             ' copy data Column A(1), D(3), S(18), T(19)
            If mycell.Offset(0, 1) = "Active" Then
            Union(mycell, mycell.Offset(0, -3), mycell.Offset(0, 15), mycell.Offset(0, 16)).Copy
             
             ' choose sheet Not Attendend
            Sheets("Not Attended").Activate
             'find  free row for write
            intFreeRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
             ' Paste data only Value
            Cells(intFreeRow, 1).PasteSpecial xlPasteValues 'xlPasteAll
            Application.CutCopyMode = False
             ' choose sheet Master Sheet
            Sheets("Master Sheet").Activate
            End If
             
             
        End If
    Next mycell
     
    Application.ScreenUpdating = True
    MsgBox "Finished"
     
End Sub

Display More

cbanks · Apr 25th 2007

Re: Copying A Range From One Worksheet Into An Area In Another Workbook

Code

Sub Copy
   Workbooks.Open Filename:= _
    "C:\TDocuments.xls"
    Workbooks("Blank.xls").Activate 'need to define email workbook name here
    Sheets("Email").Activate
    Range("L1:Q1").Select
    Selection.Copy
    Workbooks("TDocuments.xls").Activate
    intFreeRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
                Cells(intFreeRow, 1).Paste
    ActiveWorkbook.Save   
 End Sub

Display More

cbanks · Apr 25th 2007

Re: Copy And Paste Columns Based On Formula

This should work

Code

Sub MyCopyData()
     
    Dim mycell As Range
    Dim intFreeRow As Integer
    Const DateInterval As Byte = 14
     
    Application.ScreenUpdating = False
     
     ' Clear date of sheet Not attendent
    Sheets("Not Attended").Cells.ClearContents
     
     ' choose sheet Master Sheet
    Sheets("Master Sheet").Activate
     ' runing each cell in Column A(1)
    For Each mycell In Range("D3:D65536").Cells
         ' activecell is empty = Exit For
        If Len(mycell) = 0 Then Exit For
         ' compare Date - Interval
        If Date - DateInterval > mycell Then
             ' copy data Column A(1), D(3), S(18), T(19)
            Union(mycell, mycell.Offset(0, -3), mycell.Offset(0, 15), mycell.Offset(0, 16)).Copy
             
             ' choose sheet Not Attendend
            Sheets("Not Attended").Activate
             'find  free row for write
            intFreeRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
             ' Paste data only Value
            Cells(intFreeRow, 1).PasteSpecial xlPasteValues 'xlPasteAll
            Application.CutCopyMode = False
             
             ' choose sheet Master Sheet
            Sheets("Master Sheet").Activate
             
        End If
    Next mycell
     
    Application.ScreenUpdating = True
    MsgBox "Finished"
     
End Sub

Display More

cbanks · Apr 25th 2007

Re: Copy And Paste Columns Based On Formula

can you post an example workbook with a little more data than the previous one?

cbanks · Apr 25th 2007

Re: Userform Causing Lockup?

Try setting your form to modeless. You will need to modify the code below to your form name.

Code

UserForm1.Show (vbModeless)

cbanks · Apr 25th 2007

Re: Copy And Paste Columns Based On Formula

Not sure why but this macro is setup only to run if a cell in column e is selected. Try selecting a cell within that column before running the macro.

cbanks · Apr 25th 2007

Re: Checking If Cells Are Blank (with Added Msgbox)

Code

Sub help()
If Range("Z2") = "" Then
MsgBox ("Please fill in blank cells.")
Exit Sub
ElseIf Range("Z3") = "" Then
MsgBox ("Please fill in blank cells.")
Exit Sub
ElseIf Range("Z4") = "$--k" Then
MsgBox ("Please fill in blank cells.")
Exit Sub
End If
End Sub

Display More

cbanks · Apr 24th 2007

Re: Vba For Multiple Addresses Via Range

Yes, I understand, but you can create your own groups in your personal address book.

cbanks · Apr 24th 2007

Re: Vba For Multiple Addresses Via Range

I believe it falls under spam, or something of that nature dealing with mass mailings. Here is what I use to send emails to individual employees. Outlook does allow you to create groups maybe you should utilize that feature.

Code

Sub Email()
     'ActiveWorkbook.SendMail Recipients:="email address"
     'This example send the last saved version of the Activeworkbook
     'You must add a reference to the Microsoft outlook Library
    Dim OutApp As Object
    Dim OutMail As Object
     For Each cell In Range("a2:a65536").Cells.SpecialCells(xlCellTypeConstants)
         
        email_ = cell.Value
        cc_ = cell.Offset(0, 1).Value
        subject_ = cell.Offset(0, 2).Value
        body_ = cell.Offset(0, 3).Value
        
         ' attach_ = cell.Offset(0, 4).Value
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
            .To = email_
            .Subject = subject_
            .Body = body_
            .CC = cc_
       ' .Attachments.Add ActiveWorkbook.FullName
         'You can add other files also like this
         '.Attachments.Add ("C:\test.txt")
      '  .Send or use
      
        .Display
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
   Next
  
End Sub

Display More

cbanks · Apr 24th 2007

Re: Vba For Multiple Addresses Via Range

Im not sure if I can proceed with answering this question. It may violate the terms of the forum. I will need a moderator to take a look at this question before I proceed. Sry. Cbanks

cbanks · Apr 24th 2007

Re: Vba For Multiple Addresses Via Range

right direction

Code

Sub Email()
     'ActiveWorkbook.SendMail Recipients:="email address"
     'This example send the last saved version of the Activeworkbook
     'You must add a reference to the Microsoft outlook Library
    Dim OutApp As Object
    Dim OutMail As Object
     
         
        email_ = Range("A2") & ";" & Range("A3")
        cc_ = ""
        subject_ = ""
        body_ = ""
        
         ' attach_ = cell.Offset(0, 4).Value
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
            .To = email_
            .Subject = subject_
            .Body = body_
            .CC = cc_
 
        .Display
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing

Display More

cbanks · Apr 24th 2007

Re: Fill Down In Filtered List With Vba

Try this. You may have to adjust the range to see if it fits.

Code

Dim lrow As Long, rngtarget As Range
   With ActiveSheet
        lrow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set rngtarget = .Range("A2:I" & lrow) 'Set begin row here
        With rngtarget
            .AutoFilter field:=5, Criteria1:="2000" 'criteria
            .AutoFilter field:=6, Criteria1:="=.0000.0100.0000" 'criteria
            .AutoFilter field:=7, Criteria1:="=.010.120007" 'criteria
        End With
        rngtarget.Columns("I").SpecialCells(xlCellTypeVisible).FormulaR1C1 = "TCS Domestic"
        rngtarget.AutoFilter
        End With

Display More

cbanks · Apr 24th 2007

Re: Missing A Reference?

Check your copy and pasting. Your workbook functions are probably referencing their old file/location. If so, you will need to remove this reference.

cbanks · Apr 24th 2007

Re: Fill Down In Filtered List With Vba

Please post the code you have so far.

cbanks · Apr 17th 2007

Hi, Im looking to create a macro to compile a list in a single column from information listed in columns e-gg. There maybe blank cells so I do not know if that will matter. The I would like the list to be compiled in column b beginning with cell b2. Thanks for the help.

cbanks · Apr 16th 2007

Re: Setting Column As Integer

How do i set iCol to begin with col M?

cbanks · Apr 16th 2007

Re: Setting Column As Integer

Sendkeys is how this data entry program works. I am aware of its unreliability, but in this system its what is reliable.

cbanks · Apr 16th 2007

Re: Setting Column As Integer

txt
Myscreen.Area
Myscreen.Pustring

these are all programming related to my object. Each of these i have defined, or created in my macro.

How do i set it to increase. Im unfamiliar with richie's suggested use. I removed the code i tried with richies help. The error I was getting came as I tried to +1 the icol.

cbanks · Apr 16th 2007

Re: Setting Column As Integer

My code in its entirety.. as you can see I just labeled each column different, but this creates a lot of empty cells since not all data meets the if statements.

Code

Public Sub Name_Find()
    Dim row As Integer
    Dim answer As Integer
    
    
    answer = MsgBox("Make sure that you have UPAS open to the Welcome Screen" & vbCrLf & "Please make sure all other excel documents are closed. If they are not, hit Cancel and do so.", vbOKCancel, "Open Passport")
    If answer = 2 Then Exit Sub
    row = 2
    
    Set_Objects
    
    Dim operator As String
    Dim tempMonth As String
    Dim tempDay As String
    Dim tempYear As String
    Dim tempEffDate As String
    Dim temppol
     MyScreen.Putstring "A", 20, 10
     SendKey "<ENTER>"
        
    Do Until Workbooks("Book1").Worksheets(1).Range("A" & row) = ""
        MyScreen.Putstring Workbooks("Book1").Worksheets(1).Range("C" & row), 16, 32
        MyScreen.Putstring Workbooks("Book1").Worksheets(1).Range("B" & row), 20, 32
        SendKey "<ENTER>"
        Do Until MyScreen.area(24, 2, 24, 2) = "N"
        If Trim(txt(7, 10, 25)) = Workbooks("Book1").Worksheets(1).Range("D" & row) Then
        MyScreen.area(7, 4, 7, 5).Copy
        MyScreen.area(22, 40, 22, 41).Paste
        SendKey "<ENTER>"
            If MyScreen.area(7, 57, 7, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("E" & row) = Trim(txt(7, 57, 74))
            
            End If
            If MyScreen.area(8, 57, 8, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("F" & row) = Trim(txt(8, 57, 74))
            
            End If
            If MyScreen.area(9, 57, 9, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("G" & row) = Trim(txt(9, 57, 74))
            
            End If
            If MyScreen.area(10, 57, 10, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("H" & row) = Trim(txt(10, 57, 74))
            
            End If
            If MyScreen.area(11, 57, 11, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("I" & row) = Trim(txt(11, 57, 74))
            
            End If
            SendKey "<PF7>"
            
        End If
            If Trim(txt(8, 10, 25)) = Workbooks("Book1").Worksheets(1).Range("A" & row) Then
        MyScreen.area(8, 4, 8, 5).Copy
        MyScreen.area(22, 40, 22, 41).Paste
        SendKey "<ENTER>"
            If MyScreen.area(7, 57, 7, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("J" & row) = Trim(txt(7, 57, 74))
            
            End If
            If MyScreen.area(8, 57, 8, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("A" & row) = Trim(txt(8, 57, 74))
            
            End If
            If MyScreen.area(9, 57, 9, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("L" & row) = Trim(txt(9, 57, 74))
            
            End If
            If MyScreen.area(10, 57, 10, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("M" & row) = Trim(txt(10, 57, 74))
            
            End If
            If MyScreen.area(11, 57, 11, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("N" & row) = Trim(txt(11, 57, 74))
            
            End If
            SendKey "<PF7>"
            
        End If
                If Trim(txt(9, 10, 25)) = Workbooks("Book1").Worksheets(1).Range("A" & row) Then
        MyScreen.area(9, 4, 9, 5).Copy
        MyScreen.area(22, 40, 22, 41).Paste
        SendKey "<ENTER>"
            If MyScreen.area(7, 57, 7, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("O" & row) = Trim(txt(7, 57, 74))
            
            End If
            If MyScreen.area(8, 57, 8, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("P" & row) = Trim(txt(8, 57, 74))
            
            End If
            If MyScreen.area(9, 57, 9, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("Q" & row) = Trim(txt(9, 57, 74))
            
            End If
            If MyScreen.area(10, 57, 10, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("R" & row) = Trim(txt(10, 57, 74))
            
            End If
            If MyScreen.area(11, 57, 11, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("S" & row) = Trim(txt(11, 57, 74))
            
            End If
            SendKey "<PF7>"
            
        End If
                If Trim(txt(10, 10, 25)) = Workbooks("Book1").Worksheets(1).Range("A" & row) Then
        MyScreen.area(10, 4, 10, 5).Copy
        MyScreen.area(22, 40, 22, 41).Paste
        SendKey "<ENTER>"
            If MyScreen.area(7, 57, 7, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("T" & row) = Trim(txt(7, 57, 74))
            
            End If
            If MyScreen.area(8, 57, 8, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("U" & row) = Trim(txt(8, 57, 74))
            
            End If
            If MyScreen.area(9, 57, 9, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("V" & row) = Trim(txt(9, 57, 74))
            
            End If
            If MyScreen.area(10, 57, 10, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("W" & row) = Trim(txt(10, 57, 74))
            
            End If
            If MyScreen.area(11, 57, 11, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("X" & row) = Trim(txt(11, 57, 74))
            
            End If
            SendKey "<PF7>"
            
        End If
                If Trim(txt(11, 10, 25)) = Workbooks("Book1").Worksheets(1).Range("A" & row) Then
        MyScreen.area(11, 4, 11, 5).Copy
        MyScreen.area(22, 40, 22, 41).Paste
        SendKey "<ENTER>"
            If MyScreen.area(7, 57, 7, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("Y" & row) = Trim(txt(7, 57, 74))
            
            End If
            If MyScreen.area(8, 57, 8, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("Z" & row) = Trim(txt(8, 57, 74))
            
            End If
            If MyScreen.area(9, 57, 9, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AA" & row) = Trim(txt(9, 57, 74))
            
            End If
            If MyScreen.area(10, 57, 10, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AB" & row) = Trim(txt(10, 57, 74))
            
            End If
            If MyScreen.area(11, 57, 11, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AC" & row) = Trim(txt(11, 57, 74))
            
            End If
            SendKey "<PF7>"
            
        End If
            If Trim(txt(12, 10, 25)) = Workbooks("Book1").Worksheets(1).Range("A" & row) Then
        MyScreen.area(12, 4, 12, 5).Copy
        MyScreen.area(22, 40, 22, 41).Paste
        SendKey "<ENTER>"
            If MyScreen.area(7, 57, 7, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AD" & row) = Trim(txt(7, 57, 74))
            
            End If
            If MyScreen.area(8, 57, 8, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AE" & row) = Trim(txt(8, 57, 74))
            
            End If
            If MyScreen.area(9, 57, 9, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AF" & row) = Trim(txt(9, 57, 74))
            
            End If
            If MyScreen.area(10, 57, 10, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AG" & row) = Trim(txt(10, 57, 74))
            
            End If
            If MyScreen.area(11, 57, 11, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AH" & row) = Trim(txt(11, 57, 74))
            
            End If
            SendKey "<PF7>"
            
        End If
            If Trim(txt(13, 10, 25)) = Workbooks("Book1").Worksheets(1).Range("A" & row) Then
        MyScreen.area(13, 4, 13, 5).Copy
        MyScreen.area(22, 40, 22, 41).Paste
        SendKey "<ENTER>"
            If MyScreen.area(7, 57, 7, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AI" & row) = Trim(txt(7, 57, 74))
            
            End If
            If MyScreen.area(8, 57, 8, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AJ" & row) = Trim(txt(8, 57, 74))
            
            End If
            If MyScreen.area(9, 57, 9, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AK" & row) = Trim(txt(9, 57, 74))
            
            End If
            If MyScreen.area(10, 57, 10, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AL" & row) = Trim(txt(10, 57, 74))
            
            End If
            If MyScreen.area(11, 57, 11, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AM" & row) = Trim(txt(11, 57, 74))
            
            End If
            SendKey "<PF7>"
            
        End If
            If Trim(txt(14, 10, 25)) = Workbooks("Book1").Worksheets(1).Range("A" & row) Then
        MyScreen.area(14, 4, 14, 5).Copy
        MyScreen.area(22, 40, 22, 41).Paste
        SendKey "<ENTER>"
            If MyScreen.area(7, 57, 7, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AN" & row) = Trim(txt(7, 57, 74))
            
            End If
            If MyScreen.area(8, 57, 8, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AO" & row) = Trim(txt(8, 57, 74))
            
            End If
            If MyScreen.area(9, 57, 9, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AP" & row) = Trim(txt(9, 57, 74))
            
            End If
            If MyScreen.area(10, 57, 10, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AQ" & row) = Trim(txt(10, 57, 74))
            
            End If
            If MyScreen.area(11, 57, 11, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AR" & row) = Trim(txt(11, 57, 74))
            
            End If
            SendKey "<PF7>"
            
        End If
            If Trim(txt(15, 10, 25)) = Workbooks("Book1").Worksheets(1).Range("A" & row) Then
        MyScreen.area(15, 4, 15, 5).Copy
        MyScreen.area(22, 40, 22, 41).Paste
        SendKey "<ENTER>"
            If MyScreen.area(7, 57, 7, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AS" & row) = Trim(txt(7, 57, 74))
            
            End If
            If MyScreen.area(8, 57, 8, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AT" & row) = Trim(txt(8, 57, 74))
            
            End If
            If MyScreen.area(9, 57, 9, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AU" & row) = Trim(txt(9, 57, 74))
            
            End If
            If MyScreen.area(10, 57, 10, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AV" & row) = Trim(txt(10, 57, 74))
            
            End If
            If MyScreen.area(11, 57, 11, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AW" & row) = Trim(txt(11, 57, 74))
            
            End If
            SendKey "<PF7>"
            
        End If
            If Trim(txt(16, 10, 25)) = Workbooks("Book1").Worksheets(1).Range("A" & row) Then
        MyScreen.area(16, 4, 16, 5).Copy
        MyScreen.area(22, 40, 22, 41).Paste
        SendKey "<ENTER>"
            If MyScreen.area(7, 57, 7, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AX" & row) = Trim(txt(7, 57, 74))
            
            End If
            If MyScreen.area(8, 57, 8, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AY" & row) = Trim(txt(8, 57, 74))
            
            End If
            If MyScreen.area(9, 57, 9, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("AZ" & row) = Trim(txt(9, 57, 74))
            
            End If
            If MyScreen.area(10, 57, 10, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("BA" & row) = Trim(txt(10, 57, 74))
            
            End If
            If MyScreen.area(11, 57, 11, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("BB" & row) = Trim(txt(11, 57, 74))
            
            End If
            SendKey "<PF7>"
            
        End If
            If Trim(txt(17, 10, 25)) = Workbooks("Book1").Worksheets(1).Range("A" & row) Then
        MyScreen.area(17, 4, 17, 5).Copy
        MyScreen.area(22, 40, 22, 41).Paste
        SendKey "<ENTER>"
            If MyScreen.area(7, 57, 7, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("BC" & row) = Trim(txt(7, 57, 74))
            
            End If
            If MyScreen.area(8, 57, 8, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("BD" & row) = Trim(txt(8, 57, 74))
            
            End If
            If MyScreen.area(9, 57, 9, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("BE" & row) = Trim(txt(9, 57, 74))
            
            End If
            If MyScreen.area(10, 57, 10, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("BF" & row) = Trim(txt(10, 57, 74))
            
            End If
            If MyScreen.area(11, 57, 11, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("BG" & row) = Trim(txt(11, 57, 74))
            
            End If
            SendKey "<PF7>"
            
        End If
            If Trim(txt(18, 10, 25)) = Workbooks("Book1").Worksheets(1).Range("A" & row) Then
        MyScreen.area(18, 4, 18, 5).Copy
        MyScreen.area(22, 40, 22, 41).Paste
        SendKey "<ENTER>"
            If MyScreen.area(7, 57, 7, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("BH" & row) = Trim(txt(7, 57, 74))
            
            End If
            If MyScreen.area(8, 57, 8, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("BI" & row) = Trim(txt(8, 57, 74))
            
            End If
            If MyScreen.area(9, 57, 9, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("BJ" & row) = Trim(txt(9, 57, 74))
            
            End If
            If MyScreen.area(10, 57, 10, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("BK" & row) = Trim(txt(10, 57, 74))
            
            End If
            If MyScreen.area(11, 57, 11, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("BL" & row) = Trim(txt(11, 57, 74))
            
            End If
            SendKey "<PF7>"
            
        End If
            If Trim(txt(19, 10, 25)) = Workbooks("Book1").Worksheets(1).Range("A" & row) Then
        MyScreen.area(19, 4, 19, 5).Copy
        MyScreen.area(22, 40, 22, 41).Paste
        SendKey "<ENTER>"
            If MyScreen.area(7, 57, 7, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("BM" & row) = Trim(txt(7, 57, 74))
            
            End If
            If MyScreen.area(8, 57, 8, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("BN" & row) = Trim(txt(8, 57, 74))
            
            End If
            If MyScreen.area(9, 57, 9, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("BO" & row) = Trim(txt(9, 57, 74))
            
            End If
            If MyScreen.area(10, 57, 10, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("BP" & row) = Trim(txt(10, 57, 74))
            
            End If
            If MyScreen.area(11, 57, 11, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("BQ" & row) = Trim(txt(11, 57, 74))
            
            End If
            SendKey "<PF7>"
            
        End If
            If Trim(txt(20, 10, 25)) = Workbooks("Book1").Worksheets(1).Range("A" & row) Then
        MyScreen.area(20, 4, 20, 5).Copy
        MyScreen.area(22, 40, 22, 41).Paste
        SendKey "<ENTER>"
            If MyScreen.area(7, 57, 7, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("BR" & row) = Trim(txt(7, 57, 74))
            
            End If
            If MyScreen.area(8, 57, 8, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("BS" & row) = Trim(txt(8, 57, 74))
            
            End If
            If MyScreen.area(9, 57, 9, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("BT" & row) = Trim(txt(9, 57, 74))
            
            End If
            If MyScreen.area(10, 57, 10, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("BU" & row) = Trim(txt(10, 57, 74))
            
            End If
            If MyScreen.area(11, 57, 11, 57) = "A" Then
            Workbooks("Book1").Worksheets(1).Range("BV" & row) = Trim(txt(11, 57, 74))
            
            End If
            SendKey "<PF7>"
            
        End If
        SendKey "<PF1>"
        DoEvents
        Loop


        SendKey "<PF8>"
        SendKey "<ERASEINPU>"
        row = row + 1
        DoEvents
    Loop
    
    MsgBox "Task Completed"
    


End Sub

Display More