Misunderstood Type Mismatch Error

E

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

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Sort by date Sort by votes
What is the Selection.Value in the first and second loop?
 
Upvote 0
Welcome to the forum.

Is there an error value in C2 on the second pass?
 
Upvote 0
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
 
Upvote 0
Have you checked what Selection actually is?
 
Upvote 0
It looks like the selection isn't changing (i.e. selecting C2 value but I want it to select C3, then C4, etc.).
 
Upvote 0
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.
 
Upvote 0
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


Jonmo1 said:
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.
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Copy data from multiple sheets into a master sheet - VBA button stuck
Replies
3
Views
372
NdNoviceHlp
NdNoviceHlp
V
  • Question Question
Export from Excel to MS Project and Indenting
Replies
1
Views
450
Trevor G
Trevor G
N
  • Question Question
Finding the differences then copy and paste code to a new sheet
Replies
1
Views
667
myall_blues
myall_blues
R
  • Question Question
Compose Email VBA Help
Replies
1
Views
139
Logit
Logit
R
  • Question Question
[VBA] - Need to Hide one column and need sum of columns
Replies
0
Views
197
rsolanki
R

Forum statistics

Threads
1,224,823
Messages
6,181,178
Members
453,021
Latest member
Justyna P

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