Misunderstood Type Mismatch Error

ERKSMTY

New Member
Joined
May 17, 2017
Messages
9
This code throws a type mismatch error on the second loop through at
Code:
[COLOR=#FF0000]Do While Selection.Value <> ""[/COLOR]
. I have no idea what's causing this. Any ideas?

Thank you for your time!

Code:
Sub OpenProjectCopyPasteData2()


Dim PrjApp      As MSProject.Application
Dim aProg       As MSProject.Project
Dim PrjRange    As Range
Dim PrjFullName As String
Dim t           As Task
Dim rng         As Range
Dim rng1        As Range
Dim ws1         As Worksheet
Dim ws2         As Worksheet
Dim MyCell      As String
Dim Lastrow     As Long


Set ws1 = Worksheets("MS Project Milestones")
Set rng1 = ws1.Range("A:F")
Set ws2 = Worksheets("Active NRE Projects")


Set PrjApp = New MSProject.Application




'Clear current contents of Project Data tab
rng1.ClearContents


'For Each MyCell In PrjRange


Application.ScreenUpdating = False
Application.DisplayAlerts = False


'Open MS Project file


ws2.Activate


ActiveSheet.Range("C2").Select


[COLOR=#ff0000]Do While Selection.Value <> ""[/COLOR]
MyCell = Selection.Value
PrjFullName = MyCell


PrjApp.FileOpenEx PrjFullName
Set aProg = PrjApp.ActiveProject


' show all tasks
'OutlineShowAllTasks


ws1.Activate


'Copy the project columns and paste into Excel
SelectTaskColumn Column:="Name"
EditCopy
Set ws1 = Worksheets("MS Project Milestones")
Set rng = ws1.Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1)
rng.PasteSpecial xlPasteValues
rng.PasteSpecial xlPasteFormats


SelectTaskColumn Column:="Resource Names"
EditCopy
Set rng = ws1.Range("B" & Cells(Rows.Count, "B").End(xlUp).Row + 1)
rng.PasteSpecial xlPasteValues
rng.PasteSpecial xlPasteFormats


SelectTaskColumn Column:="Finish"
EditCopy
Set rng = ws1.Range("F" & Cells(Rows.Count, "F").End(xlUp).Row + 1)
rng.PasteSpecial xlPasteValues
rng.PasteSpecial xlPasteFormats


SelectTaskColumn Column:="Text1"
EditCopy
Set rng = ws1.Range("C" & Cells(Rows.Count, "C").End(xlUp).Row + 1)
rng.PasteSpecial xlPasteValues
rng.PasteSpecial xlPasteFormats


SelectTaskColumn Column:="Text2"
EditCopy
Set rng = ws1.Range("D" & Cells(Rows.Count, "D").End(xlUp).Row + 1)
rng.PasteSpecial xlPasteValues
rng.PasteSpecial xlPasteFormats




With Sheets("MS Project Milestones")
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        Lastrow = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Row
    Else
        Lastrow = 1
    End If
End With


With Sheets("MS Project Milestones")
        .Range("A" & (Lastrow + 1)).Value = "X"
        .Range("B" & (Lastrow + 1)).Value = "X"
        .Range("C" & (Lastrow + 1)).Value = "X"
        .Range("D" & (Lastrow + 1)).Value = "X"
        .Range("F" & (Lastrow + 1)).Value = "X"
End With






' reset settings of Excel and MS-Project
Application.DisplayAlerts = True
Application.ScreenUpdating = True
PrjApp.ScreenUpdating = True
PrjApp.DisplayAlerts = True


'PrjApp.FileClose False
PrjApp.Quit pjDoNotSave
Set PrjApp = Nothing


Selection.Offset(1, 0).Select
Loop


End Sub
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

yky

Well-known Member
Joined
Jun 7, 2011
Messages
1,875
Office Version
  1. 2010
Platform
  1. Windows
What is the Selection.Value in the first and second loop?
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
37,192
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
Welcome to the forum.

Is there an error value in C2 on the second pass?
 

ERKSMTY

New Member
Joined
May 17, 2017
Messages
9
The selection values are file paths (e.g. L:\ABC\Schedule.mpp). It works on the first loop through, but the second loops fails even when the file paths are identical in C2 and C3.


A colleague suggested replace
Code:
Do While Selection.Value <> ""MyCell = Selection.Value
PrjFullName = MyCell
with
Code:
ActiveSheet.Range("C2").SelectMyCell = Selection.Value
Do Until IsEmpty(MyCell)

But it still throws the type mismatch error.



Code:
Sub OpenProjectCopyPasteData()

Dim PrjApp      As MSProject.Application
Dim aProg       As MSProject.Project
Dim PrjFullName As String
Dim t           As Task
Dim rng         As Range
Dim rng1        As Range
Dim ws1         As Worksheet
Dim ws2         As Worksheet
Dim MyCell      As Variant
Dim Lastrow     As Long


Set ws1 = Worksheets("MS Project Milestones")
Set rng1 = ws1.Range("A:F")
Set ws2 = Worksheets("Active NRE Projects")


Set PrjApp = New MSProject.Application


Application.ScreenUpdating = False
Application.DisplayAlerts = False




'Clear current contents of Project Data tab
rng1.ClearContents


'Open MS Project file


ws2.Activate


ActiveSheet.Range("C2").Select
MyCell = Selection.Value
Do Until IsEmpty(MyCell)


PrjApp.FileOpenEx MyCell
Set aProg = PrjApp.ActiveProject


' show all tasks
OutlineShowAllTasks


ws1.Activate


'Copy the project columns and paste into Excel
SelectTaskColumn Column:="Name"
EditCopy
Set ws1 = Worksheets("MS Project Milestones")
Set rng = ws1.Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1)
rng.PasteSpecial xlPasteValues
rng.PasteSpecial xlPasteFormats


SelectTaskColumn Column:="Resource Names"
EditCopy
Set rng = ws1.Range("B" & Cells(Rows.Count, "B").End(xlUp).Row + 1)
rng.PasteSpecial xlPasteValues
rng.PasteSpecial xlPasteFormats


SelectTaskColumn Column:="Finish"
EditCopy
Set rng = ws1.Range("F" & Cells(Rows.Count, "F").End(xlUp).Row + 1)
rng.PasteSpecial xlPasteValues
rng.PasteSpecial xlPasteFormats


SelectTaskColumn Column:="Text1"
EditCopy
Set rng = ws1.Range("C" & Cells(Rows.Count, "C").End(xlUp).Row + 1)
rng.PasteSpecial xlPasteValues
rng.PasteSpecial xlPasteFormats


SelectTaskColumn Column:="Text2"
EditCopy
Set rng = ws1.Range("D" & Cells(Rows.Count, "D").End(xlUp).Row + 1)
rng.PasteSpecial xlPasteValues
rng.PasteSpecial xlPasteFormats


With Sheets("MS Project Milestones")
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        Lastrow = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Row
    Else
        Lastrow = 1
    End If
End With


With Sheets("MS Project Milestones")
        .Range("A" & (Lastrow + 1)).Value = "X"
        .Range("B" & (Lastrow + 1)).Value = "X"
        .Range("C" & (Lastrow + 1)).Value = "X"
        .Range("D" & (Lastrow + 1)).Value = "X"
        .Range("F" & (Lastrow + 1)).Value = "X"
End With


PrjApp.FileClose False
PrjApp.Quit pjDoNotSave
Set PrjApp = Nothing


Selection.Offset(1, 0).Select
Loop


' reset settings of Excel and MS-Project
Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub
 

ERKSMTY

New Member
Joined
May 17, 2017
Messages
9

ADVERTISEMENT

See my thread reply below. Thanks for the welcome!
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,300
Office Version
  1. 365
Platform
  1. Windows
Have you checked what Selection actually is?
 

ERKSMTY

New Member
Joined
May 17, 2017
Messages
9

ADVERTISEMENT

It looks like the selection isn't changing (i.e. selecting C2 value but I want it to select C3, then C4, etc.).
 

Jonmo1

MrExcel MVP
Joined
Oct 12, 2006
Messages
44,061
One of the first commands after the loop begins is
ws1.Activate

But at the end of the loop, it never goes back to the original sheet (ws2)

Basically on the first loop, selection is C2 on ws2.
But on the 2nd loop, selection is an unkown cell on ws1
It's hard to tell from your code which cell is last selected on that sheet, but selection is definately NOT C3 on ws2.
 

ERKSMTY

New Member
Joined
May 17, 2017
Messages
9
Thanks for pointing that out. I reworked the code, and I can see that the value in cell C3 is passed into MyCell, but it won't open the document (it fails at PrjApp.FileOpenEx MyCell)

Updated Code:

Code:
Sub OpenProjectCopyPasteData2()

Dim PrjApp      As MSProject.Application
Dim aProg       As MSProject.Project
Dim PrjFullName As String
Dim t           As Task
Dim rng         As Range
Dim rng1        As Range
Dim ws1         As Worksheet
Dim ws2         As Worksheet
Dim MyCell      As Variant
Dim Lastrow     As Long
Dim FileRow     As String


Set ws1 = Worksheets("MS Project Milestones")
Set rng1 = ws1.Range("A:F")
Set ws2 = Worksheets("Active NRE Projects")


Set PrjApp = New MSProject.Application


Application.ScreenUpdating = False
Application.DisplayAlerts = False


'Clear current contents of Project Data tab
rng1.ClearContents


'Open MS Project file


NumFiles = Application.CountA(Sheets("Active NRE Projects").Range("C2:C50"))


ws2.Activate


For x = 1 To NumFiles
    FileRow = "C" & 1 + x
    
    MyCell = Range(FileRow)
    If MyCell = "" Then End
    
PrjApp.FileOpenEx MyCell
Set aProg = PrjApp.ActiveProject


' show all tasks
OutlineShowAllTasks


ws1.Activate


'Copy the project columns and paste into Excel
SelectTaskColumn Column:="Name"
EditCopy
Set ws1 = Worksheets("MS Project Milestones")
Set rng = ws1.Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1)
rng.PasteSpecial xlPasteValues
rng.PasteSpecial xlPasteFormats


SelectTaskColumn Column:="Resource Names"
EditCopy
Set rng = ws1.Range("B" & Cells(Rows.Count, "B").End(xlUp).Row + 1)
rng.PasteSpecial xlPasteValues
rng.PasteSpecial xlPasteFormats


SelectTaskColumn Column:="Finish"
EditCopy
Set rng = ws1.Range("F" & Cells(Rows.Count, "F").End(xlUp).Row + 1)
rng.PasteSpecial xlPasteValues
rng.PasteSpecial xlPasteFormats


SelectTaskColumn Column:="Text1"
EditCopy
Set rng = ws1.Range("C" & Cells(Rows.Count, "C").End(xlUp).Row + 1)
rng.PasteSpecial xlPasteValues
rng.PasteSpecial xlPasteFormats


SelectTaskColumn Column:="Text2"
EditCopy
Set rng = ws1.Range("D" & Cells(Rows.Count, "D").End(xlUp).Row + 1)
rng.PasteSpecial xlPasteValues
rng.PasteSpecial xlPasteFormats


With Sheets("MS Project Milestones")
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        Lastrow = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Row
    Else
        Lastrow = 1
    End If
End With


With Sheets("MS Project Milestones")
        .Range("A" & (Lastrow + 1)).Value = "X"
        .Range("B" & (Lastrow + 1)).Value = "X"
        .Range("C" & (Lastrow + 1)).Value = "X"
        .Range("D" & (Lastrow + 1)).Value = "X"
        .Range("F" & (Lastrow + 1)).Value = "X"
End With


PrjApp.FileClose False
PrjApp.Quit pjDoNotSave
Set PrjApp = Nothing


ws2.Activate
Next x


' reset settings of Excel and MS-Project
Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub


One of the first commands after the loop begins is
ws1.Activate

But at the end of the loop, it never goes back to the original sheet (ws2)

Basically on the first loop, selection is C2 on ws2.
But on the 2nd loop, selection is an unkown cell on ws1
It's hard to tell from your code which cell is last selected on that sheet, but selection is definately NOT C3 on ws2.
 

Forum statistics

Threads
1,137,351
Messages
5,680,991
Members
419,948
Latest member
Sbakker1

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
Top