Help! What is wrong? My code is not looping!

[elaineada75]

Can anyone please help?
My code is not looping. I have many files in the folder, but it can only read one file correctly and stop. What is wrong? Pl advise. Thanks.

Sub LoopFileS()
Dim wbConsol As Workbook
Dim wbTemp As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim stSupplierName As String
Dim stCompliance As String
Dim starResults As String
Dim starResults1 As String
Dim starResults2 As String
Dim lNextRow As Long
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Set wbConsol = ThisWorkbook
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then Exit Sub ' GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
'myPath = myPath
If myPath = "" Then Exit Sub
myExtension = "*.xls*"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wbTemp = Workbooks.Open(Filename:=myPath & myFile)
'Ensure Workbook has opened before moving on to next line of code
DoEvents
stSupplierName = Range("B3")
stCompliance = Range("C17")
starResults = Range("C21")
starResults1 = Range("C23")
starResults2 = Range("C27")
wbTemp.Close SaveChanges:=False
lNextRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row + 7
Range("B" & lNextRow) = stSupplierName
Range("C" & lNextRow) = stCompliance
Range("D" & lNextRow) = starResults
Range("E" & lNextRow) = starResults1
Range("F" & lNextRow) = starResults2
DoEvents
myFile = Dir
Loop
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub

[rollis13]

Tested your macro, it does loop correctly. Try to debug it using key F8 to step through the code to see what happens.
Alt+F8 to open "Run Macro" then use "Step Into" and use F8 to advance line by line
or Alt+F11 to goto VBE then use F8.

[elaineada75]

Thanks, i tried your steps.
The macro does read the files, but it kept overwriting at row 7 on the master file. How to rewrite the code such that it will flow to row 8 after picking up the data from the first file? Thanks

[jolivanes]

Your last cell calculation is for Column A with "lNextRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row + 7"
However, you are entering the new data starting in Column B so maybe change the "A" in your last cell calculation to a "B" (Sheet1.Range("B" & Rows.Count).End(xlUp).Row + 7)

[elaineada75]

It still cannot work. I hv attached the files here. Please help me with this. This is killing me!

[jolivanes]

If you change this line

lNextRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row + 7

to

lNextRow = Sheet1.Range("B" & Sheet1.Rows.Count).End(xlUp).Row + 7

Does that do anything?

[rollis13]

Since your "Results" sheet is Sheet16 apply these changes to your code. The added row is needed because you have a merged-cell in B6-B7.
Here:

'...
wbTemp.Close SaveChanges:=False
lNextRow = Sheet16.Range("B" & Rows.Count).End(xlUp).Row + 1 '<- changed
If lNextRow = 7 Then lNextRow = lNextRow + 1 '<- added
Range("B" & lNextRow) = stSupplierName
'...

[snb]

Reduce the code to:

Sub M_snb()
  redim sp(2000,4)

  with Application.FileDialog(4)
    if .show then
      c00 = .selecteditems(1) & "\"
      c01 = dir(c00 & "*.xls*")

      Do until c01 = ""
        with getobject(c00 & c01)
          sn =.sheets(1).range("A1:C27")
          .close 0
        end with

        for j = 1 to 5
          sp(n,j-1) = sn(choose(j,3,17,21,23,27),iif(j = 1,2,3))
        next

        n = n+1
        c01 = Dir
      Loop

      sheet1.cells.unmerge
      sheet1.cells(rows.count,1).end(xlup).offset(1,1).resize(ubound(sp),5) = sp
    end if
  end with 
End Sub

[elaineada75]

Reduce the code to:

Sub M_snb()
  redim sp(2000,4)

  with Application.FileDialog(4)
    if .show then
      c00 = .selecteditems(1) & "\"
      c01 = dir(c00 & "*.xls*")

      Do until c01 = ""
        with getobject(c00 & c01)
          sn =.sheets(1).range("A1:C27")
          .close 0
        end with

        for j = 1 to 5
          sp(n,j-1) = sn(choose(j,3,17,21,23,27),iif(j = 1,2,3))
        next

        n = n+1
        c01 = Dir
      Loop

      sheet1.cells.unmerge
      sheet1.cells(rows.count,1).end(xlup).offset(1,1).resize(ubound(sp),5) = sp
    end if
  end with 
End Sub

Thanks, but the code cannot run.
I received a run-time error '432': File name or class name not found during Automation operation at
with getobject(c00 & c01)

[elaineada75]

Since your "Results" sheet is Sheet16 apply these changes to your code. The added row is needed because you have a merged-cell in B6-B7.
Here:

'...
wbTemp.Close SaveChanges:=False
lNextRow = Sheet16.Range("B" & Rows.Count).End(xlUp).Row + 1 '<- changed
If lNextRow = 7 Then lNextRow = lNextRow + 1 '<- added
Range("B" & lNextRow) = stSupplierName
'...

Thanks, but it didnt work out, nothing was reflected in the file.

[elaineada75]

If you change this line

lNextRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row + 7

to

lNextRow = Sheet1.Range("B" & Sheet1.Rows.Count).End(xlUp).Row + 7

Does that do anything?

nah, it is still the same. I really couldn't understand what has got wrong

[snb]

I received a run-time error '432': File name or class name not found during Automation operation at
with getobject(c00 & c01)

I can't see which folder you picked.
But try:

        with getobject(replace(c00 & c01,"\\","\"))

You can check the values of c00 and c01 using

Msgbox c00 & c01

[elaineada75]

I can't see which folder you picked.
But try:

        with getobject(replace(c00 & c01,"\\","\"))

You can check the values of c00 and c01 using

Msgbox c00 & c01

Hi, the values did return the name of the files to pick up the data, but this time round is with run time error -2147221020 (800401e4): Automation error Invalid syntax.

[rollis13]

My changes in post #7 refer to your attached files in post #5. Don't you think that before providing a solution I didn't test it ?
If you are using your original file maybe you need to adjust some sheet/range references in the code.

[elaineada75]

My changes in post #7 refer to your attached files in post #5. Don't you think that before providing a solution I didn't test it ?
If you are using your original file maybe you need to adjust some sheet/range references in the code.

yes, i tried, i changed from sheet 16 to sheet1 but it only picked up info from 1 file and the info was written in row 2 and not in row 7.

[snb]

What folder do you pick ?

Sub M_snb()
  ReDim sp(2000, 4)

  With Application.FileDialog(4)
    If .Show Then
      c00 = .SelectedItems(1) & "\"
      c01 = Dir(c00 & "*.xls*")

      Do Until c01 = ""
        msgbox c00 & c01
        With GetObject(c00 & c01)
          sn = .Sheets(1).Range("A1:C27")
          .Close 0
        End With

        For j = 1 To 5
          sp(n, j - 1) = sn(Choose(j, 3, 17, 21, 23, 27), IIf(j = 1, 2, 3))
        Next

        n = n + 1
        c01 = Dir
      Loop

      Sheets(1).Cells.UnMerge
      Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 1).Resize(UBound(sp), 5) = sp
    End If
  End With
End Sub

Please show a screenshot of the msgbox value.

[rollis13]

[...]the info was written in row 2 and not in row 7.

This means that you have no data in column B,or, because this code doesn't refer to your project:

lNextRow = Sheet16.Range("B" & Rows.Count).End(xlUp).Row + 1 '<- changed