Trouble with macro copying columns from one worksheet to another same workbook

Hi,
I have some code I am trying to use to copy specific columns from one worksheet to another worksheet in the same workbook.  I need help to determine why it doesn't work.  

When code runs it takes you to directory to pick file, deletes some extraneous records than concatenates the record number with the seq num.  Then I want to take specific columns and copy to new worksheet.  This is where it bombs.

I have attached the code I'm using and data file.
Thanks.
CopyColumns.txt
Data-file101413.xls
rhadashAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

byundtMechanical EngineerCommented:
Your problem was failure to fully qualify your worksheet references.

I overcame that be creating two worksheet variables: wsOld and wsNew. I then used a With block to minimize the need to reference wsOld. Within that With block, I just need to put a dot before Column, Row, Range or Cells to create a fully qualified reference: .Range("A1"), .Columns(fred), .Rows(1), etc. And where I thought you meant to be referring to the newly added worksheet, I changed the code to read wsNew.Range("A1"), etc.

I also declared all variables. This is both good practice, and something I am forced to do by using Option Explicit at the top of every module sheet. My VBA Editor enforces that good habit because I checked the box to "Require Variable Declaration" in the Tools...Options...Editor menu item.

Finally, there was a discrepancy in the header label for "VIDEO TOLL TRANSACTION #SEQ NUM". Your code omitted the "SEQ NUM" at the end, thereby causing a run-time error. You could fix the problem either by adding the missing text or an asterisk wildcard character.
Sub Hertz_Maryland_FileUploadFormat()
'
' HertzABG_Phoenix_FileUpload Macro
'
Dim Filter As String, sText As String, Title As String
Dim FilterIndex As Integer
Dim fileName As Variant
Dim ddue As Long, dst As Long, i1 As Long, iMax As Long, pn As Long, ps As Long, _
    tat As Long, td As Long, tm As Long, vs As Long, x As Long
Dim fred As Range
Dim wsNew As Worksheet, wsOld As Worksheet
' File filters
Filter = "Excel Files (*.xls),*.xls," & _
        "Text Files (*.txt),*.txt," & _
        "All Files (*.*),*.*"
' Default Filter to *.*
FilterIndex = 3
' Set Dialog Caption
Title = "Select a File to Open"
' Select Start Drive & Path

                    '*****Brad had to comment out the next two statements for testing
ChDrive ("I")
ChDir ("I:\Production\File Uploads\Hertz\Maryland EZ Pass\Original")
With Application
    ' Set File Name to selected File
    fileName = .GetOpenFilename(Filter, FilterIndex, Title)
    ' Reset Start Drive/Path
    ChDrive (Left(.DefaultFilePath, 1))
    ChDir (.DefaultFilePath)
End With
' Exit on Cancel
If fileName = False Then
    MsgBox "No file was selected."
    Exit Sub
' Open File
End If
Workbooks.Open fileName
Set wsOld = ActiveSheet
    
    With wsOld
    
'copies active sheet to new sheet and renames sheet to 'Upload' and deletes unnecessary colmns
        .Name = "Sheet1"

        sText = "Hertz Equipment Rental Corp"
        sText = LCase(sText)
        iMax = .Cells.SpecialCells(xlCellTypeLastCell).Row
    
        For i1 = iMax To 1 Step -1
            If InStr(1, LCase(.Cells(i1, 3)), sText) <> 0 Then
                .Rows(i1).EntireRow.Delete
            End If
        Next i1
    
        sText = "Hertz Rental Equipment Corp"
        sText = LCase(sText)
        iMax = .Cells.SpecialCells(xlCellTypeLastCell).Row
    
        For i1 = iMax To 1 Step -1
            If InStr(1, LCase(Cells(i1, 3)), sText) <> 0 Then
                .Rows(i1).EntireRow.Delete
            End If
        Next i1
      
'Concatenate vionum (video Toll transaction# and Seq Num)
        For x = 1 To .Range("A65536").End(xlUp).Row
                .Range("P" & x).Value = (.Range("P" & x).Value & (.Range("Q" & x).Value))
        Next x
        .Cells(1, 17) = "VIDEO TOLL TRANSACTION#"
      
        Set wsNew = Sheets.Add
    
   'THIS IS WHERE IT BOMBS columns
        Set fred = .Cells.Find(What:="*", After:=Range("A1"), SearchDirection:=xlPrevious, SearchOrder:=xlByColumns)
        .Columns(fred.Column).Copy Destination:=wsNew.Columns(fred.Column)
        Application.CutCopyMode = True
    
        ps = WorksheetFunction.Match("PLATE STATE", .Rows("1:1"), 0)
        pn = WorksheetFunction.Match("PLATE", .Rows("1:1"), 0)
        vs = WorksheetFunction.Match("VIDEO TOLL TRANSACTION #SEQ NUM", .Rows("1:1"), 0)
        td = WorksheetFunction.Match("EXIT DATE/TIME", .Rows("1:1"), 0)
        tm = WorksheetFunction.Match("EXIT DATE/TIME", .Rows("1:1"), 0)
        tat = WorksheetFunction.Match("TOTAL DUE", .Rows("1:1"), 0)
        'fat = WorksheetFunction.Match(" Amount Paying ", .Rows("1:1"), 0)
        dst = WorksheetFunction.Match("DATA DATE", .Rows("1:1"), 0)
        ddue = WorksheetFunction.Match("FEE DUE", .Rows("1:1"), 0)
           
        .Columns(vs).Copy Destination:=wsNew.Range("A1")
        .Columns(td).Copy Destination:=wsNew.Range("B1")
        .Columns(tm).Copy Destination:=wsNew.Range("C1")
        .Columns(ps).Copy Destination:=wsNew.Range("D1")
        .Columns(pn).Copy Destination:=wsNew.Range("E1")
        .Columns(tat).Copy Destination:=wsNew.Range("F1")
        '.Columns(fat).Copy Destination:=wsNew.Range("G1")
        .Columns(dst).Copy Destination:=wsNew.Range("H1")
        .Columns(ddue).Copy Destination:=wsNew.Range("I1")

    End With
    
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
rhadashAuthor Commented:
Thanks for the detailed response.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Legacy OS

From novice to tech pro — start learning today.