Macro doing activities twice.

Hello Everyone,

I have buid a code to pull counts from other files and it takes some time. While to do this i want to show User form and i have added it in my code and it is displaying it. But the problem is Macro is doing the activities twice. and i not getting where i am worng. Please help...
PFA for the same Sample.xls

Sub corefunction()
Application.ScreenUpdating = False
waitform.Show
DoEvents
Shstart.Select
Dim path As Variant
path = Range("C1").value & Range("G1").Text & "\" & Range("H1").Text & "\" & Range("i1").Text & "\"
lastrow = Sheets("start").Cells(Rows.Count, "A").End(xlUp).Row
XLSDirectory = path

Dim Runname As String
Dim Index As String

First = True
Do
    If First = True Then
        Xlsfilename = Dir(XLSDirectory & "*.xls")
        First = False
        Else
        Xlsfilename = Dir()
        
   End If
        If Xlsfilename <> "" Then
        Workbooks.Open Filename:=XLSDirectory & Xlsfilename
        Set oldbk = ActiveWorkbook
        
        With ThisWorkbook
        Dim wbkbname As Variant
        wbkname = ActiveWorkbook.Name
         Shstart.Activate
         Worksheets("Start").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).value = wbkname
         oldbk.Activate
         Dim ws As Worksheet
    For Each ws In Worksheets
        ws.Activate
        Dim value As Long
        Dim shname As Variant
        
        value = Application.WorksheetFunction.CountA(Range("A:A")) - 1
        Shstart.Activate
        Dim lastrow2 As Long
        lastrow2 = Range("A" & Rows.Count).End(xlUp).Row
        Range("A" & Rows.Count).End(xlUp).Select
        Cells(lastrow2, Columns.Count).End(xlToLeft).Offset(0, 1).Activate
        ActiveCell.value = value
        oldbk.Activate
        Next ws
        ActiveWorkbook.Close
End With
End If
             
Loop While Xlsfilename <> ""
Shstart.Range("A3").Select

 waitform.Hide
MsgBox "Macro Completed, Please Review...!", vbInformation, "Developed By : Deepak Sirsale"
End Sub

Your sample has a password on the vba project.

Opss Sorry... It's Invincible

Sub corefunction_1()
Dim path As Variant
Dim lastrow As Variant
Dim runname As String
Dim index As String
Dim xlsfilename As Variant
Dim oldbk
Dim ws
waitform.Show
Application.ScreenUpdating = False
With wbkbname.Shstart
    path = .Range("C1").value & .Range("G1").Text & "\" & .Range("H1").Text & "\" & .Range("i1").Text & "\"
    lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
    xlsfilename = Dir(path & "*.xls")
    Do Until xlsfilename = ""
        Set oldbk = Workbooks.Open(path & xlsfilename)
        .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).value = oldbk.Name
        For Each ws In oldbk.Sheets
            .Range("A" & .Rows.Count).End(xlUp).Offset(0, .Columns.Count - 1).End(xlToLeft).Offset(0, 1) = _
                WorksheetFunction.CountA(ws.Range("A:A")) - 1
        Next ws
    oldbk.Close False
    Loop
End With
waitform.Hide
MsgBox "Macro Completed, Please Review...!", vbInformation
End Sub

Looking through your code, that is how I would do it. Not sure if it will fix your problem..

Hi yudlugar,

Thanks for your help, but the above code is not working fine, It is selecting First file from folder and doing activities..... but not going on next file..
and the macro is not stopping it is contineously selting first file and so on.... and also the form is displaying in white color...

Hi yudlugar,

The Code is working fine, Except Userform... it is showing White coloured form.... and when i use Doevents then it it showing the from but same issue as my coding has.... it is running twice.....

You have "corefunction" written in your userform_activate event. So when you load the userform it will repeat the code again!

Use do events and delete the userform_activate code from the userform code module.

Oh.... !!! Thanks..... Now working perfect...!!