help! Looping through folder simple adjustment

[jordanburch]

Hey Guys,

I have the following it works great to import the data, but there is a loop when I dont want there to be. I would like for it to still append data as I have different workbooks that need to be appended to the data that I create in the Co SAR tab. I know its something simple. It keeps erroring out of the My File = Dir, i believe its trying to loop for the next file, but I only want the file with the name that I designated. I am then going to change this sub to import 3 other files in 3 other locations and with 3 other names. Any help is appreciated.

Jordan


Sub COSARimportfinal()
Dim MyFile As String
Dim erow As Long
Dim Filepath As String
Dim wb1 As Workbook, wb2 As Workbook
Dim data_wbk4 As String
Dim data_wbk2 As String

Dim fn As String
Dim fn2 As String
Dim fn3 As String
Dim fn4 As String
Dim ShtName1 As String
Dim ShtName2 As String
Dim ShtName3 As String
ShtName1 = "Detail Lines"
ShtName2 = "Detail"
ShtName3 = "Detail -"

data_wbk4 = InputBox("Enter FY I.E. FY20", Default:="FY20")
data_wbk2 = InputBox("Enter month I.E. 08-MAY20", Default:="08-MAY20")
data_wbk6 = InputBox("Enter month Name I.E. YYYYMM:", Default:="202005")
fn4 = Right(data_wbk2, 5)
fn = Left(data_wbk2, 6)
fn2 = Right(data_wbk2, 2)
fn3 = Right(data_wbk6, 2)
Application.ScreenUpdating = False
Worksheets.Add(After:=Worksheets(1)).Name = "CO SAR"
Set wb1 = ThisWorkbook

data_wbk6 = InputBox("Enter month Name I.E. YYYYMM:", Default:="202005")

Filepath = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\Source Files\21 Field Details\" & data_wbk4 & "\" & data_wbk2 & "\Field Detail Lines\"
'K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\DRP\2020 DRP\2020-05 Reporting Cycle
MyFile = "CO21army" & fn4 & ".xlsx"
Do While MyFile > 0 And MyFile <> "suspense automation.xlsm"

erow = wb1.Sheets("CO SAR").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Set wb2 = Workbooks.Open(Filepath & MyFile)
With wb2


Dim ShtName As String
ShtName = "Sheet 1"
If Evaluate("isref('" & ShtName & "'!A1)") Then
'sheet exists do something
Else
'sheet doesn't exist do something else
End If
If Evaluate("isref('" & ShtName1 & "'!A1)") Then

.Sheets("Detail Lines").Range("a21000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)
.Close savechanges:=False
ElseIf Evaluate("isref('" & ShtName3 & "'!A1)") Then
.Sheets("Detail Lines").Range("a21000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)
.Close savechanges:=False

ElseIf Evaluate("isref('" & ShtName2 & "'!A1)") Then
.Sheets("Detail Lines").Range("a21000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)
.Close savechanges:=False

End If



End With
My File= Dir
Application.ScreenUpdating = True
End Sub

 

[JLGWhiz]

Looks like you have attempted to modify a macro that previously used the DIR function to work multiple files, but did not delete all the lines that become irrelevant if the DIR function is deleted. You can delete the 'My File = Dir' line since there is no Dir() function to refer to. You can also delete the Do While line because there is no Loop to close it and it will error without the 'Loop'.

 

[jordanburch]

Looks like you have attempted to modify a macro that previously used the DIR function to work multiple files, but did not delete all the lines that become irrelevant if the DIR function is deleted. You can delete the 'My File = Dir' line since there is no Dir() function to refer to. You can also delete the Do While line because there is no Loop to close it and it will error without the 'Loop'.

thanks bud works like a charm! I appreciate your help!

 

[JLGWhiz]

thanks bud works like a charm! I appreciate your help!

You're welcome,
regards, JLG