0

I have a code that copy values from a selected sheet to a master sheet. When the first run is completed; I need to select the second sheet. For some strange reason I need to perform it 3 or more times before it is correct. I've checked it over and over but couldn't find it. It are two codes but linked to each other.

Can somebody help me?

    Sub Update_SISdata_STB()
    '
    ' Update_SISdata Macro
    '
Set Workbook = ThisWorkbook
Sheets("Meetstaten").Select
WorkbooknameSISdata = ActiveWorkbook.Name
    
MsgBox "Selecteer de steigerbouwdump om te importeren ", vbMsgBoxSetForeground, "BIS Industrial Services"

Workbookname_ASESR = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Please select a file")
        
If Workbookname_ASESR = False Then
    ' They pressed Cancel
    MsgBox "Er is geen bestand geselecteerd om te openen!", vbExclamation, "BIS Industrial Services"
    Exit Sub        'GoTo exit_openfile

Else
    Sheets("Meetstaten").Select

    'Clear filter
    On Error Resume Next
    Sheets("Meetstaten").ShowAllData
    Range("A6").Select
    

    Dim LastRow As Long
    With ActiveSheet
    LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row 'laatste regel bepalen
    End With
    If LastRow > 5 Then
        Range("A6:V" & LastRow).Select
        Selection.ClearContents
    End If
    Range("A6").Select

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    'WorkbooknameYMOE = ActiveWorkbook.Name

    Workbooks.Open Filename:=Workbookname_ASESR
    Workbookname_ASESR = ActiveWorkbook.Name
    Windows(Workbookname_ASESR).Activate

    ActiveWindow.WindowState = xlMaximized
    'Dim LastRow As Long
    With ActiveSheet
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'laatste regel bepalen
    End With
    
    'copy Meetstaat, Project, Debiteur
    Range("A2:C" & LastRow).Select
    Selection.Copy

    Windows(WorkbooknameSISdata).Activate
    Range("C6").Select
    ActiveSheet.Paste

    'Workbooks.Open Filename:=Workbookname_ASESR
    'Workbookname_ASESR = ActiveWorkbook.Name
    Windows(Workbookname_ASESR).Activate

    ActiveWindow.WindowState = xlMaximized
    'Copy Prio1, prio2, prio3, prio4, prio5
    Range("D2:H" & LastRow).Select
    Selection.Copy

    Windows(WorkbooknameSISdata).Activate
    Range("F6").Select
    ActiveSheet.Paste

    'copy datum SES montage
    Windows(Workbookname_ASESR).Activate
    ActiveWindow.WindowState = xlMaximized
    Range("M2:M" & LastRow).Select
    Selection.Copy

    Windows(WorkbooknameSISdata).Activate
    Range("K6").Select
    ActiveSheet.Paste
    
    'copy datum SES huur, SESnr montage
    Windows(Workbookname_ASESR).Activate
    ActiveWindow.WindowState = xlMaximized
    Range("P2:P" & LastRow).Select
    Selection.Copy

    Windows(WorkbooknameSISdata).Activate
    Range("M6").Select
    ActiveSheet.Paste
    
    'copy SESnr Huur
     '        Windows(Workbookname_ASESR).Activate
     '        ActiveWindow.WindowState = xlMaximized
      '        Range("R2:R" & LastRow).Select
      '        Selection.Copy
       '
          '        Windows(WorkbooknameSISdata).Activate
          '        Range("N6").Select
           '        ActiveSheet.Paste
    
    'copy inhuur, uithuur
    Windows(Workbookname_ASESR).Activate
    ActiveWindow.WindowState = xlMaximized
    Range("W2:X" & LastRow).Select
    Selection.Copy

    Windows(WorkbooknameSISdata).Activate
    Range("O6").Select
    ActiveSheet.Paste
     
    'copy montage_demontage-bedrag, Huurbedrag
    Windows(Workbookname_ASESR).Activate
    ActiveWindow.WindowState = xlMaximized
    Range("AG2:AH" & LastRow).Select
    Selection.Copy

    Windows(WorkbooknameSISdata).Activate
    Range("Q6").Select
    ActiveSheet.Paste
    
    'copy Totaalbedrag, gefact_mon_demon, gefact_huur, gefact_totaal
    Windows(Workbookname_ASESR).Activate
    ActiveWindow.WindowState = xlMaximized
    Range("AK2:AN" & LastRow).Select
    Selection.Copy

    Windows(WorkbooknameSISdata).Activate
    Range("S6").Select
    ActiveSheet.Paste
    
    Windows(Workbookname_ASESR).Close savechanges:=False
End If

Call Update_SISdata_ISO

Windows(WorkbooknameSISdata).Activate
With ActiveSheet
    LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row 'laatste regel bepalen
End With
            
Range("A5:AM5").Select
Selection.AutoFilter

Range("A5:AM5").Select
Selection.AutoFilter

ActiveSheet.ShowAllData

With ActiveSheet
LastRow = .Cells(.Rows.Count, "C6").End(xlUp).Row 'laatste regel bepalen
End With

ActiveSheet.Range("$A$5:$AM" & LastRow).AutoFilter Field:=25, Criteria1:="<=0", _
Operator:=xlAnd

With ActiveSheet
LastRow = .Cells(.Rows.Count, "C6").End(xlUp).Row 'laatste regel bepalen
End With

With ActiveSheet
    Set rngFilt = Application.Intersect(.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible), .Range("A:V"))
End With

rngFilt.Delete

ActiveSheet.ShowAllData

Range("W6:AM6").Select
Selection.AutoFill Destination:=Range("W6:AM1200"), Type:=xlFillDefault

With ActiveSheet
LastRow = .Cells(.Rows.Count, "C6").End(xlUp).Row 'laatste regel bepalen
End With

For Edit_row = 6 To LastRow
    Range("A" & Edit_row) = Mid(Range("D" & Edit_row), 34, 10)
    
    If Range("M" & Edit_row) <> "CONFIRMED" Then
        Range("B" & Edit_row) = Range("M" & Edit_row)
    End If

    If Range("K" & Edit_row).Value = "  -   -" Then
        Range("K" & Edit_row) = ""
    End If
    If Range("L" & Edit_row).Value = "  -   -" Then
    'If IsEmpty(Range("L" & Edit_row).Value) = True Then
        Range("L" & Edit_row) = ""
    End If
    
Next Edit_row


With ActiveSheet
LastRow = .Cells(.Rows.Count, "C6").End(xlUp).Row 'laatste regel bepalen
End With
ActiveWorkbook.ActiveSheet.Range("S2") = Application.WorksheetFunction.Subtotal(109, Range("S6:S" & LastRow))
ActiveWorkbook.ActiveSheet.Range("S3") = Application.WorksheetFunction.Subtotal(109, Range("S6:S" & LastRow))

ActiveWorkbook.ActiveSheet.Range("T2") = Application.WorksheetFunction.Subtotal(109, Range("T6:T" & LastRow))
ActiveWorkbook.ActiveSheet.Range("T3") = Application.WorksheetFunction.Subtotal(109, Range("T6:T" & LastRow))

ActiveWorkbook.ActiveSheet.Range("U2") = Application.WorksheetFunction.Subtotal(109, Range("U6:U" & LastRow))
ActiveWorkbook.ActiveSheet.Range("U3") = Application.WorksheetFunction.Subtotal(109, Range("U6:U" & LastRow))

ActiveWorkbook.ActiveSheet.Range("V2") = Application.WorksheetFunction.Subtotal(109, Range("V6:V" & LastRow))
ActiveWorkbook.ActiveSheet.Range("V3") = Application.WorksheetFunction.Subtotal(109, Range("V6:V" & LastRow))

ActiveWorkbook.ActiveSheet.Range("W2") = Application.WorksheetFunction.Subtotal(109, Range("W6:W" & LastRow))
ActiveWorkbook.ActiveSheet.Range("W3") = Application.WorksheetFunction.Subtotal(109, Range("W6:W" & LastRow))

ActiveWorkbook.ActiveSheet.Range("X2") = Application.WorksheetFunction.Subtotal(109, Range("X6:X" & LastRow))
ActiveWorkbook.ActiveSheet.Range("X3") = Application.WorksheetFunction.Subtotal(109, Range("X6:X" & LastRow))

ActiveWorkbook.ActiveSheet.Range("Y2") = Application.WorksheetFunction.Subtotal(109, Range("Y6:Y" & LastRow))
ActiveWorkbook.ActiveSheet.Range("Y3") = Application.WorksheetFunction.Subtotal(109, Range("Y6:Y" & LastRow))

ActiveWorkbook.ActiveSheet.Range("AF2") = Application.WorksheetFunction.Subtotal(109, Range("AF6:AF" & LastRow))
ActiveWorkbook.ActiveSheet.Range("AG2") = Application.WorksheetFunction.Subtotal(109, Range("AG6:AG" & LastRow))
ActiveWorkbook.ActiveSheet.Range("AH2") = Application.WorksheetFunction.Subtotal(109, Range("AH6:AH" & LastRow))
ActiveWorkbook.ActiveSheet.Range("AI2") = Application.WorksheetFunction.Subtotal(109, Range("AI6:AI" & LastRow))
ActiveWorkbook.ActiveSheet.Range("AJ2") = Application.WorksheetFunction.Subtotal(109, Range("AJ6:AJ" & LastRow))
ActiveWorkbook.ActiveSheet.Range("AK2") = Application.WorksheetFunction.Subtotal(109, Range("AK6:AK" & LastRow))
ActiveWorkbook.ActiveSheet.Range("AL2") = Application.WorksheetFunction.Subtotal(109, Range("AL6:AL" & LastRow))

' Verversen draaitabellen
Dim pivC As PivotCache

For Each pivC In ActiveWorkbook.PivotCaches
    pivC.Refresh
Next


End Sub

Sub Update_SISdata_ISO()
'
' Update_SISdata Macro
 '
Set Workbook = ThisWorkbook
Sheets("Meetstaten").Select
WorkbooknameSISdata = ActiveWorkbook.Name
    
MsgBox "Selecteer de Isolatiedump om te importeren ", vbMsgBoxSetForeground, "BIS Industrial Services"

Workbookname_ASESR = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Please select a file")
        
If Workbookname_ASESR = False Then
    ' They pressed Cancel
    MsgBox "Er is geen bestand geselecteerd om te openen!", vbExclamation, "BIS Industrial Services"
    Exit Sub        'GoTo exit_openfile

Else
    Sheets("Meetstaten").Select

    'Clear filter
    'Sheets("Meetstaten").ShowAllData
    Range("A6").Select

    Dim LastRow_STB As Long
    With ActiveSheet
    LastRow_STB = .Cells(.Rows.Count, "C").End(xlUp).Row 'laatste regel bepalen
    End With
    '        If LastRow_STB > 5 Then
'            Range("A6:V" & LastRow).Select
 '            Selection.ClearContents
     '        End If
     '        Range("A6").Select

    LastRow_STB = LastRow_STB + 1
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    'WorkbooknameYMOE = ActiveWorkbook.Name

    Workbooks.Open Filename:=Workbookname_ASESR
    Workbookname_ASESR = ActiveWorkbook.Name
    Windows(Workbookname_ASESR).Activate

    ActiveWindow.WindowState = xlMaximized
    Dim LastRow_ISO As Long
    With ActiveSheet
    LastRow_ISO = .Cells(.Rows.Count, "A").End(xlUp).Row 'laatste regel bepalen
    End With
    
    'copy Meetstaat, Project, Debiteur
    Range("A2:C" & LastRow_ISO).Select
    Selection.Copy

    Windows(WorkbooknameSISdata).Activate
    Range("C" & LastRow_STB).Select
    ActiveSheet.Paste

    'Workbooks.Open Filename:=Workbookname_ASESR
    'Workbookname_ASESR = ActiveWorkbook.Name
    Windows(Workbookname_ASESR).Activate

    ActiveWindow.WindowState = xlMaximized
    'Copy Prio1, prio2, prio3, prio4, prio5
    Range("F2:J" & LastRow_ISO).Select
    Selection.Copy

    Windows(WorkbooknameSISdata).Activate
    Range("F" & LastRow_STB).Select
    ActiveSheet.Paste

    'copy datum SES montage
    Windows(Workbookname_ASESR).Activate
    ActiveWindow.WindowState = xlMaximized
    Range("AK2:AK" & LastRow_ISO).Select
    Selection.Copy

    Windows(WorkbooknameSISdata).Activate
    Range("K" & LastRow_STB).Select
    ActiveSheet.Paste
    
    'copy datum SES huur blijft LEEG, SESnr montage
    Windows(Workbookname_ASESR).Activate
    ActiveWindow.WindowState = xlMaximized
    Range("AM2:AM" & LastRow_ISO).Select
    Selection.Copy

    Windows(WorkbooknameSISdata).Activate
    Range("M" & LastRow_STB).Select
    ActiveSheet.Paste
    
    'copy SESnr Huur blijft LEEG
'        Windows(Workbookname_ASESR).Activate
'        ActiveWindow.WindowState = xlMaximized
'        Range("R2:R" & LastRow).Select
'        Selection.Copy
    '
'        Windows(WorkbooknameSISdata).Activate
'        Range("N" & LastRow_STB).Select
'        ActiveSheet.Paste
    
    'copy inhuur, uithuur
    Windows(Workbookname_ASESR).Activate
    ActiveWindow.WindowState = xlMaximized
    Range("P2:P" & LastRow_ISO).Select
    Selection.Copy
    ' Inhuur
    Windows(WorkbooknameSISdata).Activate
    Range("O" & LastRow_STB).Select
    ActiveSheet.Paste
    ' Uithuur
    Windows(WorkbooknameSISdata).Activate
    Range("P" & LastRow_STB).Select
    ActiveSheet.Paste
     
    'copy montage_demontage_bedrag, Huurbedrag
    Windows(Workbookname_ASESR).Activate
    ActiveWindow.WindowState = xlMaximized
    Range("W2:W" & LastRow_ISO).Select
    Selection.Copy
    ' Montage_demontage_bedrag
    Windows(WorkbooknameSISdata).Activate
    Range("Q" & LastRow_STB).Select
    ActiveSheet.Paste
    ' Huurbedrag
'        Windows(WorkbooknameSISdata).Activate
'        Range("R" & LastRow_STB).Select
'        ActiveSheet.Paste
    
    'copy Totaalbedrag, gefact_mon_demon, gefact_huur, gefact_totaal
    Windows(Workbookname_ASESR).Activate
    ActiveWindow.WindowState = xlMaximized
    Range("W2:Z" & LastRow_ISO).Select
    Selection.Copy

    Windows(WorkbooknameSISdata).Activate
    Range("S" & LastRow_STB).Select
    ActiveSheet.Paste
    
    Windows(Workbookname_ASESR).Close savechanges:=False
End If
End Sub
BigBen
  • 46,229
  • 7
  • 24
  • 40
Johnny 8605
  • 1
  • 5
    You may want to see [How to avoid using Select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) – BigBen Jul 28 '21 at 19:35
  • 2
    Also a good idea to remove `On Error Resume Next`. It is hiding any errors that may be in your code. – Darrell H Jul 28 '21 at 19:52
  • One of the errors being hidden by `On Error Resume Next` is `.Cells(.Rows.Count, "C6")` which appears 4 times. `C6` I guess should be `C` – CDP1802 Jul 30 '21 at 18:06
  • Hi all, it looks like this issue occurs when it needs to be run over citrix. On local machine everything works fine but in citrix is causing some issues. It is only on my citrix connection. other colleague doesn't have any issues. – Johnny 8605 Aug 03 '21 at 09:31

1 Answers1

0

Try it without using select.

Option Explicit
Sub Update_SISdata_STB()

    Dim wb As Workbook, ws As Worksheet
    Dim LastRow As Long, Edit_row As Long
    Dim rngFilt As Range
    
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Meetstaten")
    With ws
        ' clear filter
        .AutoFilterMode = False
        LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row 'laatste regel bepalen
    
        If LastRow > 5 Then
            .Range("A6:V" & LastRow).ClearContents
        End If
        Range("A6").Select
    End With

    Call Import_SISdata_STB
    Call Update_SISdata_ISO

    With ws
        LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
        ' apply filter
        .Range("$A$5:$AM" & LastRow).AutoFilter Field:=25, Criteria1:="<=0", Operator:=xlAnd
        Set rngFilt = Application.Intersect(.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible), .Range("A:V"))
        rngFilt.Delete
        .AutoFilterMode = False
        .Range("W6:AM6").AutoFill Destination:=.Range("W6:AM1200"), Type:=xlFillDefault

        LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row 'laatste regel bepalen
        For Edit_row = 6 To LastRow
            .Range("A" & Edit_row) = Mid(.Range("D" & Edit_row), 34, 10)
            
            If .Range("M" & Edit_row) <> "CONFIRMED" Then
                .Range("B" & Edit_row) = .Range("M" & Edit_row)
            End If
        
            If .Range("K" & Edit_row).Value = "  -   -" Then
                .Range("K" & Edit_row) = ""
            End If

            If .Range("L" & Edit_row).Value = "  -   -" Then
            'If IsEmpty(Range("L" & Edit_row).Value) = True Then
                .Range("L" & Edit_row) = ""
            End If
        Next Edit_row
        .Range("S2:Y3,AF2:AL2").Formula = "=Subtotal(109,S$6:S$" & LastRow & ")"
    End With
 
    ' Verversen draaitabellen
    Dim pivC As PivotCache
    For Each pivC In ActiveWorkbook.PivotCaches
       pivC.Refresh
    Next
    MsgBox "Done"
End Sub

Sub Import_SISdata_STB()

    Dim wb As Workbook, wbIn As Workbook
    Dim ws As Worksheet, wsIn As Worksheet
    Dim FileASESR As Variant, LastRow As Long
    
    'Select the scaffolding dump to import
    MsgBox "Selecteer de steigerbouwdump om te importeren ", vbMsgBoxSetForeground, "BIS Industrial Services"
    FileASESR = Application.GetOpenFilename( _
                FileFilter:="Excel Files (*.xls), *.xls", _
                Title:="Please select a file")
            
    If FileASESR = False Then
        ' They pressed Cancel
        MsgBox "Er is geen bestand geselecteerd om te openen!", vbExclamation, "BIS Industrial Services"
        Exit Sub        'GoTo exit_openfile
    End If
        
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Meetstaten")
        
    Set wbIn = Workbooks.Open(Filename:=FileASESR, ReadOnly:=True)
    Set wsIn = wbIn.Sheets(1)
    With wsIn
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        'copy Meetstaat, Project, Debiteur
        'copy Prio1, prio2, prio3, prio4, prio5
        .Range("A2:H" & LastRow).Copy ws.Range("C6")
        'copy datum SES montage
        .Range("M2:M" & LastRow).Copy ws.Range("K6")
        'copy datum SES huur, SESnr montage
        .Range("P2:P" & LastRow).Copy ws.Range("M6")
        'copy inhuur, uithuur
        .Range("W2:X" & LastRow).Copy ws.Range("O6")
        'copy montage_demontage-bedrag, Huurbedrag
        .Range("AG2:AH" & LastRow).Copy ws.Range("Q6")
        'copy Totaalbedrag, gefact_mon_demon, gefact_huur, gefact_totaal
        .Range("AK2:AN" & LastRow).Copy ws.Range("S6")
    End With
    MsgBox "Imported " & LastRow - 1 & " rows from " & wsIn.Name, vbInformation, wbIn.Name
    wbIn.Close savechanges:=False
End Sub

Sub Update_SISdata_ISO()
   
   ' Update_SISdata Macro
    Dim wb As Workbook, wbIn As Workbook
    Dim ws As Worksheet, wsIn As Worksheet
    Dim FileASESR As Variant
    Dim LastRow_STB As Long, LastRow_ISO As Long
 
    ' Select the Insulation Dump to import
    MsgBox "Selecteer de Isolatiedump om te importeren ", vbMsgBoxSetForeground, "BIS Industrial Services"
    FileASESR = Application.GetOpenFilename( _
                FileFilter:="Excel Files (*.xls), *.xls", _
                Title:="Please select a file")
            
    If FileASESR = False Then
        ' They pressed Cancel
        MsgBox "Er is geen bestand geselecteerd om te openen!", vbExclamation, "BIS Industrial Services"
        Exit Sub 'GoTo exit_openfile
    End If
   
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Meetstaten")
    LastRow_STB = 1 + ws.Cells(ws.Rows.Count, "C").End(xlUp).Row

    Set wbIn = Workbooks.Open(Filename:=FileASESR, ReadOnly:=True)
    Set wsIn = wbIn.Sheets(1)
        With wsIn
            LastRow_ISO = .Cells(.Rows.Count, "A").End(xlUp).Row 'laatste regel bepalen
            
            'copy Meetstaat, Project, Debiteur
            .Range("A2:C" & LastRow_ISO).Copy ws.Range("C" & LastRow_STB)
            'Copy Prio1, prio2, prio3, prio4, prio5
            .Range("F2:J" & LastRow_ISO).Copy ws.Range("F" & LastRow_STB)
            'copy datum SES montage
            .Range("AK2:AK" & LastRow_ISO).Copy ws.Range("K" & LastRow_STB)
            'copy datum SES huur blijft LEEG, SESnr montage
            .Range("AM2:AM" & LastRow_ISO).Copy ws.Range("M" & LastRow_STB)
            'copy inhuur
            .Range("P2:P" & LastRow_ISO).Copy ws.Range("O" & LastRow_STB)
            ' Uithuur
            .Range("P2:P" & LastRow_ISO).Copy ws.Range("P" & LastRow_STB)
            'copy montage_demontage_bedrag, Huurbedrag
            .Range("W2:W" & LastRow_ISO).Copy ws.Range("Q" & LastRow_STB)
            'copy Totaalbedrag, gefact_mon_demon, gefact_huur, gefact_totaal
            .Range("W2:Z" & LastRow_ISO).Copy ws.Range("S" & LastRow_STB)
    End With
    MsgBox "Imported " & LastRow_ISO - 1 & " rows from " & wsIn.Name, vbInformation, wbIn.Name
    wbIn.Close savechanges:=False
End Sub
CDP1802
  • 13,871
  • 2
  • 7
  • 17