VBA Code: some part of vba code is not working

vikas9385

Board Regular
Joined
Aug 29, 2009
Messages
96
Hi, I ve 2 separate vba codes which is running successfully. Now, I've clubbed both; some part of this is not functioning properly some times it gives result but not always. Please validate & help me to sort it out...thanks in advance.

Code is as follows:


Code:
:eeek:
Option Explicit
Dim wsMaster As Workbook, xlsFiles As Workbook
Dim Filename As String
Dim File As Integer
Dim r, l As Long
Dim lr As Long 'declaration
 
Public Sub F_JUNCTION()
     With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
 
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Title = "Select files to process"
        .Show
 
        If .SelectedItems.Count = 0 Then Exit Sub
 
            Set wsMaster = ActiveWorkbook
 
        For File = 1 To .SelectedItems.Count
 
            Filename = .SelectedItems.Item(File)
 
            If Right(Filename, 4) = ".xls" Or Right(Filename, 4) = ".csv" Then
 
                Workbooks.Open Filename, 0, True
 
            Set xlsFiles = ActiveWorkbook
 
                  r = wsMaster.Sheets("Sheet1").UsedRange.Rows.Count
                 
                  l = ActiveSheet.Range("A1048576").End(xlUp).Row
                 
                  xlsFiles.ActiveSheet.Range("A3:BW" & l).Copy Destination:=wsMaster.Sheets("Sheet1").Range("A" & r).Offset(0, 0)
               
                  'xlsFiles.Sheets("Sheet1").Rows("2").Copy Destination:=wsMaster.Sheets("Sheet1").Range("A" & r).Offset(1, 0)
 
                  xlsFiles.Close SaveChanges:=False 'close without saving
 
            End If
 
        Next File 'go to the next file and repeat the process
 
     End With
 
            Set wsMaster = Nothing
            Set xlsFiles = Nothing
   
       
    ActiveSheet.Range("A1:BW" & r).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75), Header:=xlYes '
   
    ActiveSheet.Range("$A$1:$BW$" & r).AutoFilter Field:=2, Criteria1:="RI"
    Cells.Find(What:="fiscal", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
   
  
   '------another code-----Have problem in below code which is running occasionally not all the time
 
    ActiveSheet.Range("$A$1:$BW$" & r).AutoFilter Field:=2, Criteria1:="RI"
    Cells.Find(What:="fiscal", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveSheet.Range("$A$1:$BW$" & r).AutoFilter Field:=51, Criteria1:="2018"
    Selection.End(xlDown).Select
       
    Range("AU" & r + 1).Formula = "=SUBTOTAL(9,au2:au" & r & ")"
    Range("AS" & r + 1).Formula = "=SUBTOTAL(9,as2:as" & r & ")"
    Range("AQ" & r + 1).Formula = "=SUBTOTAL(9,aq2:aq" & r & ")"
    Range("AN" & r + 1).Formula = "=SUBTOTAL(9,an2:an" & r & ")"
End Sub
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

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