VBA User selecting file now the code errors Type Mismatch

R

Razor_Rob

Board Regular
Joined
Aug 18, 2022
Messages
65
Office Version
  1. 365
Platform
  1. Windows
Hi everyone,

The code below works fine, then I added a code to make the user select the file that they need to copy from and now the code comes back with an error Type Mismatch.
Sorry just learning as I go....
Also with the code that has Range ie A3:A200 , how can I just make the code go through the whole column while theres data. As the range can change.

Thanks in advance. I really appreciate it.

VBA Code: 
Sub Import_Data()

Application.ScreenUpdating = False
Application.EnableEvents = False

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim lngRow As Long
Dim BotRow As Long
Dim rng As Range
Dim WorkRng As Range
Dim Rng2 As Range
Dim WorkRng2 As Range
Dim Rng3 As Range
Dim WorkRng3 As Range

'Open a workbook
Dim fileNameAndPath As Variant
fileNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLSX), *.XLSX", Title:="Select File To Be Opened")
If fileNameAndPath = False Then Exit Sub
Workbooks.Open Filename:=fileNameAndPath
        

'Open a workbook

  'Open method requires full file path to be referenced.
 ' Workbooks.Open "\\xxxx\xxx\My Documents\Notifications\Test\Import.xlsx"
  Workbooks.Open "\\xxxx\xxx\\My Documents\Notifications\Test\Import.csv"
  
  'Open method has additional parameters
  'Workbooks.Open(FileName, UpdateLinks, ReadOnly, Format, Password, WriteResPassword, IgnoreReadOnlyRecommended, Origin, Delimiter, Editable, Notify, Converter, AddToMru, Local, CorruptLoad)
  'Help page: https://docs.microsoft.com/en-us/office/vba/api/excel.workbooks.open


  'Set wsCopy = Workbooks("Import.xlsx").Worksheets(1)
  Set wsCopy = Application.Workbooks.Open(fileNameAndPath).Worksheets(1)
  Set wsDest = Workbooks("Import.csv").Worksheets(1)
  wsDest.Cells.EntireColumn.AutoFit
    
    '1. Find last used row in the copy range based on data in column A
    lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
      
    '2. Find first blank row in the destination range based on data in column A
    'Offset property moves down 1 row
    lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
    
    '3. Clear contents of existing data range
    wsDest.Range("A3:BJ" & lDestLastRow).ClearContents

    '4. Copy & Paste Data
    wsCopy.Range("E2:BN" & lCopyLastRow).Copy _
      wsDest.Range("A3")
      
    '5 Clear contents of non required fields
    wsDest.Range("AQ3:AY200, BB3:BG200" & lDestLastRow).ClearContents
    
    '6. Convert Name to Code
    Cells(Rows.Count, "BH").Select
    Selection.End(xlUp).Select
    BotRow = Selection.Row
    For lngRow = 1 To BotRow
    If InStr(1, Cells(lngRow, "BH").Value, "BAW") > 0 Then
        Cells(lngRow, "BG") = Cells(lngRow, "BG") & "316070"
    End If
    If InStr(1, Cells(lngRow, "BH").Value, "ASA") > 0 Then
        Cells(lngRow, "BG") = Cells(lngRow, "BG") & "315191"
    End If
    If InStr(1, Cells(lngRow, "BH").Value, "MEGT") > 0 Then
        Cells(lngRow, "BG") = Cells(lngRow, "BG") & "335512"
    End If
    If InStr(1, Cells(lngRow, "BH").Value, "MRAEL") > 0 Then
        Cells(lngRow, "BG") = Cells(lngRow, "BG") & "312280"
    End If
    If InStr(1, Cells(lngRow, "BH").Value, "SARINA") > 0 Then
        Cells(lngRow, "BG") = Cells(lngRow, "BG") & "341977"
    End If
    If InStr(1, Cells(lngRow, "BH").Value, "SKILLS360") > 0 Then
        Cells(lngRow, "BG") = Cells(lngRow, "BG") & "348259"
    End If
    If InStr(1, Cells(lngRow, "BH").Value, "MAS") > 0 Then
        Cells(lngRow, "BG") = Cells(lngRow, "BG") & "324274"
    End If
    Next
    
    '7. Add Liability Category
    'wsDest.Range("AF3:AF200").Formula = "=DATEDIF(D3:D200,Now(),""y"")"
     '7a Add Liability Category
     '*******
    Dim objSheet As Worksheet, lngAgeCol As Long, lngEndRow As Long, i2 As Long
    Dim lngStartRow As Long

    With Range("AF3")
        Set objSheet = .Worksheet
        lngAgeCol = .Column
        lngStartRow = .Row + 2
    End With

    lngEndRow = objSheet.Cells.SpecialCells(xlLastCell).Row

    For i2 = lngStartRow To lngEndRow
        objSheet.Cells(i2, lngAgeCol).FormulaR1C1 = "=IF(RC[-28]="""","""",ROUNDDOWN(YEARFRAC(RC[-28],NOW()),0))"
    Next
    '*******
    
    wsDest.Activate
        
    Dim Lastrow As Long
    Dim i As Long
        
    Lastrow = Range("AF" & Rows.Count).End(xlUp).Row
    For i = 3 To Lastrow
        If Range("AF" & i).Value <= 21 Then
            Range("AE" & i).Value = "G2"
        ElseIf Range("AF" & i).Value <= 25 Then
            Range("AE" & i).Value = "G6"
        ElseIf Range("AF" & i).Value > 25 Then
            Range("AE" & i).Value = "O1"
        Else: Range("AE" & i).Value = ""
        End If
    Next i
      
    '7b  Liability
    Cells(Rows.Count, "V").Select
    Selection.End(xlUp).Select
    BotRow = Selection.Row
    For lngRow = 1 To BotRow
    If InStr(1, Cells(lngRow, "V").Value, "School Based") > 0 Then
        Cells(lngRow, "AE") = Cells(lngRow, "AE") & "21"
    End If
    Next
    
    '7c  Liability
    Cells(Rows.Count, "S").Select
    Selection.End(xlUp).Select
    BotRow = Selection.Row
    For lngRow = 1 To BotRow
    If InStr(1, Cells(lngRow, "S").Value, "TRN_FT_A") > 0 Then
        Cells(lngRow, "AE") = Cells(lngRow, "AE") & "O2"
    End If
    If InStr(1, Cells(lngRow, "S").Value, "TRN_PT_A") > 0 Then
        Cells(lngRow, "AE") = Cells(lngRow, "AE") & "O2"
    End If
    Next
      
    '8. Move Employer Name to EmpoyerExternal Org and School Name to Manually Convert and/or Request to Code
    Set WorkRng = Range("AN3:AN200")
    For Each rng In WorkRng
        If rng.Value = 0 Then
            rng.Value = rng.Offset(0, 2).Value

        End If
    Next rng
    
    Set WorkRng2 = Range("AJ3:AJ200")
    For Each Rng2 In WorkRng2
        If Rng2.Value = 0 Then
            Rng2.Value = Rng2.Offset(0, 1).Value

        End If
    Next Rng2
     
    '9. Clear DELTA Qual ID, AASN Name, Employer Name, School Name
    wsDest.Range("AZ3:AZ200,BH3:BH200, AP3:AP200, AK3:AK200, AF3:AF200" & lDestLastRow).ClearContents
        
    Set WorkRng3 = Range("AF3:AF200")
    For Each Rng3 In WorkRng3
        If Rng3.Value = 0 Then
            Rng3.Value = Rng3.Offset(0, -1).Value

        End If
    Next Rng3
    
    ' Liability code clean up for the School Based and Traineeship
    With Columns("AF") '<- Check column
        .Replace what:="G221", replacement:="21", LookAt:=xlWhole, MatchCase:=False
    End With
    With Columns("AF") '<- Check column
        .Replace what:="G2O2", replacement:="O2", LookAt:=xlWhole, MatchCase:=False
    End With
    With Columns("AF") '<- Check column
        .Replace what:="G6O2", replacement:="O2", LookAt:=xlWhole, MatchCase:=False
    End With
    With Columns("AF") '<- Check column
        .Replace what:="O1O2", replacement:="O2", LookAt:=xlWhole, MatchCase:=False
    End With

    '10 Clear Column AE Study Period
    wsDest.Range("AE3:AE200" & lDestLastRow).ClearContents
       
    '11 Remove Qual code in the Qual Title
    With Range("X3", Range("X" & Rows.Count).End(xlUp))
    .Value = Evaluate("=IF({1},MID(" & .Address & ",1,LEN(" & .Address & ")-11))")
    End With
           
    '12 Replace Yes and No to Y and N
    With Columns("BA") '<- Check column
        .Replace what:="Yes", replacement:="Y", LookAt:=xlWhole, MatchCase:=False
        .Replace what:="No", replacement:="N", LookAt:=xlWhole, MatchCase:=False
    End With
    
    '13 Put hypen on School Based
    With Columns("V") '<- Check column
        .Replace what:="School Based", replacement:="School-Based", LookAt:=xlWhole, MatchCase:=False
    End With
    
    '14a Remove spaces from the mobile number
    'Remove multiple spaces from a range
    With wsDest
    .Range("Q3:Q200", .Cells(.Rows.Count, "Q").End(xlUp)).Replace " ", vbNullString, xlPart
    End With
    
    
    '14b Add zero on the student's mob number
    Dim Lastrow2 As Long, cell As Range
    
    
    Lastrow2 = Range("Q" & Rows.Count).End(xlUp).Row       'Last used row in column A
    Range("Q3:Q" & Lastrow2).NumberFormat = "@"            'format range as text
    
    For Each cell In Range("Q3:Q" & Lastrow)
         cell.Value = Format(cell * 1, "0000000000")      'Convert each cell
    Next cell
    Range("Q3:Q" & Lastrow2).Copy Destination:=Range("Q3") 'copy to column C
        
           
    'Proper case for Address 1 and Suburb (Column I and L)
    '[I:L] = [Index(Proper(I:L),)]
    With Range("I3", Cells(Rows.Count, "I").End(xlUp))
        .Value = Evaluate("INDEX(Proper(" & .Address(External:=True) & "),)")
    End With
     With Range("L3", Cells(Rows.Count, "L").End(xlUp))
        .Value = Evaluate("INDEX(Proper(" & .Address(External:=True) & "),)")
    End With
    
    'Clear contents of existing data range
    wsDest.Range("BL2:BL" & lDestLastRow).ClearContents

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
End Sub
 
Sort by date Sort by votes
Razor_Rob said:
Setting the proper case seems to be deleting the space between the street number and street name so the value from the copied data ie 123 Street Name into the new date 123StreetName
VBA Code: 
    With wsDest.Range("I3:I" & lDestLastRow)
        .Value = Evaluate("INDEX(Proper(" & .Address(External:=True) & "),)")
    End With
  
    With wsDest.Range("L3:L" & lDestLastRow)
        .Value = Evaluate("INDEX(Proper(" & .Address(External:=True) & "),)")
    End With
Click to expand...
You might need to give me a visual of your before data (column M & P of the "Data" spreadsheet) and also show me your complete code.
Proper is not the removing the space (tested), so either there is a data issue or there is another line of code removing spaces from columns I & L.
 
Upvote 0

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
You must log in or register to reply here.

Similar threads

B
  • Question Question
VBA code to cut and paste multiple filtered rows based on multiple criteria
Replies
2
Views
1K
Alex Blakenburg
A
T
  • Question Question
Open CSV with VBA, convert to ANSI and a cell "75 %" is changed to format type percent and the value is changed to "0.75"
Replies
1
Views
347
Tanquen
T
J
  • Solved
VBA Code Error Unable to get the Match property of the WorksheetFunction class
Replies
8
Views
291
Jiraya_00
J
O
  • Question Question
User-defined type not defined - vba/excel error
Replies
4
Views
212
RoryA
RoryA
R
  • Solved
Macro To Move Files - Will Not Move .msg or .csv files
Replies
4
Views
82
rachel06
R

Forum statistics

Threads
1,223,888
Messages
6,175,217
Members
452,619
Latest member
Shiv1198

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top