Need Help reorganizing code wont find path now

[bdouglas1011]

I have the same code on another sheet and it works fine. The only difference if the path is located in cell T7 and on the other sheet it is in Cell K28

I have adjusted the cell in the code on the sheet that it is not working on but it says the path can not be found. I have tried all day trying to get it working.

In a nut shell you run the macro which goes and looks at a folder you have mapped too and finds a particular .xls file in the folder then it opens it and copies data from that file and inserts into the workbook you ran the macro on

I can attach a stripped down version of the sheet if that is an option I just dont see where to do that.

Sub UpdateSurveyGTStyle()
    Dim wBook As Workbook, path As String, maxRow As Long, wBookSvy As Worksheet, Surveys As Worksheet
    Dim col As Long, row As Long
    
    'get integers for the cell reference in the "Folder Path Cell" on the template sheet
    col = wColNumber(colRegEx(Range("K28").Text))
    row = CInt(rowRegEx(Range("K28").Text))
    
    'Turns off screen updates to avoid flashing screen
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationAutomatic
        
    'saving the survey sheet object to a variable
    Set Surveys = ThisWorkbook.Sheets("Surveys")
    
    'setting the defined path for the survey file
    path = cells(row, col).Text
    If Right(path, 1) <> "\" Then path = path + "\"
    
    'setting up the generic name for unformatted surveys, "path\<Well Name> Surveys.csv"
    Dim unformatSvy As String: unformatSvy = path + Range("G8").Text + " Surveys.csv"
    
    'Find the file marked as the survey file then exit loop
    For i = row + 2 To row + 15
        If cells(i, col + 11).Value = "Yes" Then
            path = path + cells(i, col + 2).Text
            Exit For
        End If
    Next i
    
    'Open the generated survey file under the object stored by wBook, set the page object in the open book
    Set wBook = Application.Workbooks.Open(path)
    
    
    
    
    Set wBookSvy = wBook.Sheets(1)
    
    'Find the last row in the generated survey file, then navigate to the daily sheet survey and copy MD/Inc/Azm,Temp,Source
    maxRow = Range("B14").End(xlDown).row
    Surveys.Activate
    Surveys.Range("E18:G1000" & maxRow + 4).ClearContents
    Surveys.Range("U18:U1000" & maxRow + 4).ClearContents
    Surveys.Range("V19:V1000" & maxRow + 4).ClearContents
    Surveys.Range("E18:G" & maxRow + 4) = wBookSvy.Range("B14:D" & maxRow).Value
    Surveys.Range("U18:U" & maxRow + 4) = wBookSvy.Range("M14:M" & maxRow).Value
    Surveys.Range("V19:V" & maxRow + 4) = wBookSvy.Range("N15:N" & maxRow).Value
    
    'Export PDF of survey excel sheet
    'wBook.ExportAsFixedFormat xlTypePDF, Left(path, Len(path) - 4)
    'wBookSvy.Range("A1:N" & maxRow).ExportAsFixedFormat xlTypePDF, Left(path, Len(path) - 4)
    
    'Remove all but basic header info and calculated data, export .csv with the predetermined name
    'Turn off alerts to ignore writing over a duplicate .csv file
    Application.DisplayAlerts = False
    wBookSvy.Range("A1:A12").EntireRow.Delete
    wBookSvy.Range("K1:N1").EntireColumn.Delete
        'shift columns so DLS and CL are swapped
        wBookSvy.Range("K:K").Value = wBookSvy.Range("J:J").Value
        wBookSvy.Range("J:J").Value = wBookSvy.Range("I:I").Value
        wBookSvy.Range("I:I").Value = wBookSvy.Range("K:K").Value
        wBookSvy.Range("K:K").ClearContents
    wBook.SaveAs unformatSvy, xlCSV
    wBook.Close
    Application.DisplayAlerts = True
    
    'Switch back to the template sheet. Copy bit projection if given, else copy straight line
    Sheets("Survey Email").Activate
'    Range("H8") = maxRow + 5   'Survey sheet last row
'    Surveys.Range("E" & maxRow + 5) = Surveys.Range("E" & maxRow + 4) + Range("C10").Value  'C10 is the survey sensor offset
'    If Range("J8") = "" Then
'        Surveys.Range("F" & maxRow + 5) = Range("J6").Value
'    Else
'        Surveys.Range("F" & maxRow + 5) = Range("J8").Value
'    End If
'    If Range("K8") = "" Then
 '       Surveys.Range("G" & maxRow + 5) = Range("K6").Value
'    Else
'        Surveys.Range("G" & maxRow + 5) = Range("K8").Value
'    End If
    
    'Check for active curve. Show/Hide rows in email body depending on box yes/no
'    If Range("E9") = "No" Then
'        Range("A37:A39").EntireRow.Hidden = True
'    Else
'        Range("A37:A39").EntireRow.Hidden = False
'    End If
    
    'Free objects from system memory
    Set wBook = Nothing
    Set wBookSby = Nothing
    Set Surveys = Nothing
    
    'Re-enables screen updates
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Range("A1").Activate
End Sub

 

[bdouglas1011]

Also I know this has to do with it

{1,6}"
        RE.Global = True
        RE.IgnoreCase = True
    rowRegEx = RE.Execute(cell).Item(0)
    Set RE = Nothing
End Function
Private Function colRegEx(cell As String)
    Dim RE As Object
    Set RE = CreateObject("vbscript.regexp")
        RE.Pattern = "[a-zA-Z]{1,6}"
        RE.Global = True
        RE.IgnoreCase = True
    colRegEx = RE.Execute(cell).Item(0)
    Set RE = Nothing
End Function

Private Function wColLetter(ColNum)
    wColLetter = Split(cells(1, ColNum).Address, "$")(1)
End Function
Private Function wColNumber(colLet)
    wColNumber = Range(colLet & 1).Column
End Function

I just got it to work but I had to have the exact number of columns and have the reference cell exactly in the same place on the sheet as it is on the original sheet ... the cell have to be 2 cells to the left and at the very bottom.

Hard to explain I wish I could attach the sheet ...better to see than explain

 

[Fluff]

Duplicate to: Path Returns must have been moved or deleted but it has not

In future, please do not post the same question multiple times. Per Forum Rules (#12), posts of a duplicate nature will be locked or deleted.

In relation to your question here, I have closed this thread so please continue in the linked thread.