Macro Run only a three lines of code and then stops working without any error messages

[John01]

I have the code that is working perfectly, but now it doesn't open the code line when comes to open the file from directory. I appreciate some help, thanks in advance. I have the following code:

Sub CENTRAL()

Dim cell3 As Range
Dim FileName As String
Dim CellName As String
Dim Fpath As String
Dim wb As Workbook
Dim SumResult As Double



Workbooks.Open FileName:="C:\Users\SKY\Desktop\Dom\CENTRAL.xlsx"




For Each cell3 In ActiveSheet.Range("A3:A" & Cells(Rows.Count, 1).End(xlUp).row)

finalcolumn = 1 + ActiveSheet.Cells(cell3.row, 14).End(xlToLeft).Column <-- it is executing the code till here

MsgBox finalcolumn <--- to check if it is working

Fpath = ThisWorkbook.Path & "\" <----- from this part macro stops to work
CellName = cell3.Value

FileName = Dir(Fpath & "\*" & CellName & ".xlsx")
Select Case True
Case Trim(cell3.Value) = "Total"
Case Trim(cell3.Value) <> "" And Left (FileName,14) Like "*" & CellName & "*"

Workbooks.Open FileName:=Fpath & FileName
Set wb = ActiveWorkbook
SumResult = WorksheetFunction.Sum(wb.Worksheets(1).Range("B1:B6"))
Totalsum = Totalsum + SumResult

Windows("CENTRAL.xlsx").Activate
Worksheets(1).Range(Cells(cell3.row, finalcolumn), Cells(cell3.row, finalcolumn)).Value = Totalsum
Application.CutCopyMode = False
Application.DisplayAlerts = False

wb.Close



End Select

Next cell3



End Sub

 

[jasonb75]

I expect it is a problem with the data rather than the code, try changing the end of your code to

Case Else
    ctr = ctr + 1


End Select

Next cell3
MsgBox ctr

End Sub

This will tell you how many cells don't match any of the Select Case criteria, it it is all of them then you will know that the problem is in the data.

 

[John01]

I expect it is a problem with the data rather than the code, try changing the end of your code to

Case Else
    ctr = ctr + 1


End Select

Next cell3
MsgBox ctr

End Sub

This will tell you how many cells don't match any of the Select Case criteria, it it is all of them then you will know that the problem is in the data.

Yes, it gives me 56 its just exactly the number of rows that should be compared with filename in directory. But, though I have the similar code to this that always worked and now also this code doesn't work at all. Is it because I tested more codes, and maybe in background some of the code stacked somewhere ? It is weird that on the same data before it worked perfectly and now macro doesn't start at all. This is the code :

Sub OPEN_FILE_FROM_CELL()

Dim cell3 As Range
Dim FileName As String
Dim CellName As String
Dim Fpath As String
Dim d As String
Dim wb As Workbook

Workbooks.Open FileName:="C:\Users\sky\Desktop\ADM\list total.xlsx"

For Each cell3 In ActiveSheet.Range("C3:C" & Cells(Rows.Count, 3).End(xlUp).row)

eColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
If eColumn >= 1 Then eColumn = eColumn + 1

Fpath = ThisWorkbook.Path & "\"
CellName = cell3.Value

FileName = Dir(Fpath & "\*" & CellName & ".xlsx")
    Select Case True
    Case Trim(cell3.Value) <> "" And Right(FileName, 12) Like "*" & CellName & "*"
    

                  Workbooks.Open FileName:=Fpath & FileName
                  Set wb = ActiveWorkbook
                  Range("B1:B6").Select
                  Selection.Copy
                  
                  Windows("list total.xlsx").Activate
                  ActiveSheet.Range(Cells(cell3.row, eColumn), Cells(cell3.row, eColumn)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
               
                  Application.CutCopyMode = False
                  Application.DisplayAlerts = False
      
                  wb.Close
                  
   
                  
                  End Select

Next cell3


End Sub

 

[jasonb75]

The only difference that I can see in the code is in this line,

Case Trim(cell3.Value) <> "" And Left (FileName,14) Like "*" & CellName & "*"

In this procedure you have used Left, in the one that works you have used Right?

 

[John01]

The only difference that I can see in the code is in this line,

Case Trim(cell3.Value) <> "" And Left (FileName,14) Like "*" & CellName & "*"

In this procedure you have used Left, in the one that works you have used Right?

Yes, that's right, that is only difference that I have, Left and Right in this two macros.

 

[jasonb75]

Try adding another message box at this point

FileName = Dir(Fpath & "\*" & CellName & ".xlsx")
MsgBox FileName
Select Case True

How does what you see differ from what you expect?

 

[John01]

Try adding another message box at this point

FileName = Dir(Fpath & "\*" & CellName & ".xlsx")
MsgBox FileName
Select Case True

How does what you see differ from what you expect?

I've added the message box you suggested and it gives me empty Msgbox without any file selection, but I found the problem. When I am inserting path in Fpath=
"C:\Users\sky\Desktop\ADM\" the code starts to execute like before and when I put in Fpath= ThisWorkbook.Path & "\" then happens nothing, code stops here. So the problem is that the macro doesn't want to execute the path ThisWorkbook.Path & "\" and before executed this command just fine.

 

[jasonb75]

Sounds like the workbook is saved in the wrong folder.
If you add the line

MsgBox ThisWorkbook.Path

into your code, does it show the expected path of "C:\Users\sky\Desktop\ADM\" ?

 

[John01]

Sounds like the workbook is saved in the wrong folder.
If you add the line

MsgBox ThisWorkbook.Path

into your code, does it show the expected path of "C:\Users\sky\Desktop\ADM\" ?

Yes, it shows "C:\Users\sky\Desktop\ADM\".

 

[jasonb75]

Content of a cell and the full name of the file that it should match to?

This is going to be something similar to the problem in your last thread, I have my suspicions that it could even be the same problem in reverse.