help! Looping through folder simple adjustment

jordanburch

Active Member
Joined
Jun 10, 2016
Messages
439
Office Version
  1. 2016
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("a2:p1000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)
.Close savechanges:=False
ElseIf Evaluate("isref('" & ShtName3 & "'!A1)") Then
.Sheets("Detail Lines").Range("a2:p1000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)
.Close savechanges:=False

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

End If



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

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
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'.
 
Upvote 0
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!
 
Upvote 0

Forum statistics

Threads
1,213,486
Messages
6,113,932
Members
448,533
Latest member
thietbibeboiwasaco

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