Solved

Delete data records with a specific value in Column E in each worksheet of several files

Posted on 2013-12-12
20
278 Views
Last Modified: 2013-12-24
Dear Experts:

I got hundreds of excel-files in a folder in C:\MyData

Each file has dozens of worksheet, all with the same make-up

I would like to delete data records (entire row) in all of these files using VBA with the following requirement:

Open each excel-file in C:\MyData
Go to each worksheet in each excel-file and ...
delete all data records which have the value 'NZ' in Column 'E'

Thank you very much in advance.

Regards, Andreas
0
Comment
Question by:AndreasHermle
  • 11
  • 8
20 Comments
 

Author Comment

by:AndreasHermle
ID: 39713496
Dear Experts:

I happen to come across this code snippet that does what I would like to have in just the active sheet:

Hence this code is the basis that needs to be re-written so that the deletion is completed on all worksheets of all the excel-files in C:\MyData

Help is much appreciated. Thank you very much in advance.

Regards, Andreas

Sub Delete_NZ_From_ActiveSheet()
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   Dim lastrow As Long, r As Long
   lastrow = ActiveSheet.UsedRange.Rows.Count
   For r = lastrow To 1 Step -1
      If UCase(Cells(r,5).Value) = "NZ" Then Rows(r).Delete
   Next r
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
End Sub

Open in new window

0
 
LVL 31

Assisted Solution

by:Rob Henson
Rob Henson earned 100 total points
ID: 39713555
I can expand that to check each sheet within the Active Workbook, but beyond that I am stuck.

Sub Delete_NZ_From_ActiveSheet()
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   Dim lastrow As Long, r As Long

For Each Worksheet in ActiveWorkbook.Worksheets
   ShtName = Worksheet.Name
   Sheets(ShtName).Select
   lastrow = ActiveSheet.UsedRange.Rows.Count
   For r = lastrow To 1 Step -1
      If UCase(Cells(r,5).Value) = "NZ" Then Rows(r).Delete
   Next r
Next Worksheet

   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
End Sub

Open in new window


If there are particular sheets that need to be ignored, the sheet name can be checked before doing the delete.

Thanks
Rob H
0
 

Author Comment

by:AndreasHermle
ID: 39713734
Hi Rob,

no, every sheet needs to be worked on. There are a couple of excel files that are protected. They should be omitted.

Regards, Andreas
0
 

Author Comment

by:AndreasHermle
ID: 39713794
Hi Rob,

thank you very much for your swift and professional help. Works great!

Maybe someone is able to come up with a solution ...
... to loop thru all the files in folder C:\MyData and perform the above actions.

Again, thank you very much for your great support.

Regards, Andreas
0
 
LVL 10

Expert Comment

by:broro183
ID: 39718437
hi Andreas,

Are there any subfolders in C:\MyData & if so, should they be searced for excel files too?


(another) Rob
0
 
LVL 10

Accepted Solution

by:
broro183 earned 400 total points
ID: 39718662
hi,

This is untested but I think it is on the right track. Note, the "extra" code relates to a fast way of getting to the Last cell in each opened file.

Option Explicit

Sub Delete_NZ_From_ActiveSheet_v2()
'modified from my OpenManyFiles_v2()
Const strPath As String = "C:\MyData"
Dim OriPath As String   ' Original path
Dim sFname As Variant
Dim wb As Workbook
Dim ws As Worksheet
Dim AFRng As Range
Dim VisRows As Range
Dim i As Long
Dim LastRow As Long, r As Long

    'identify the current directory & then change it to the desired path before using getopen filename
    OriPath = CurDir
    ChDir strPath
    'or    ChDir ThisWorkbook.Path
    sFname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", MultiSelect:=True)

    If IsArray(sFname) Then
        For i = LBound(sFname) To UBound(sFname)
            Set wb = Workbooks.Open(Filename:=sFname(i))
            For Each ws In wb.Worksheets
                LastRow = LastCell(ws).Row
                With ws
                    'remove any filters & turn the autofilter back on
                    If .AutoFilterMode Then
                        .AutoFilterMode = False
                    End If

                    Set AFRng = .Range(.Cells(1, 1), LastCell(ws))
                    With AFRng
                        .AutoFilter Field:=5, Criteria1:="NZ"
                        'set a range variable to the visible rows after applying the filter, test that some rows exist & delete them
                        Set VisRows = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(xlCellTypeVisible).EntireRow
                        If Not VisRows Is Nothing Then
                            VisRows.Delete Shift:=xlUp
                        End If
                        .AutoFilter Field:=5
                    End With
                End With
                Set VisRows = Nothing
                Set AFRng = Nothing
            Next ws
            wb.Close True
            Set wb = Nothing
        Next i
    End If

    'change back to user's original path
    ChDir OriPath

End Sub

Function LastCell(ws As Excel.Worksheet) As Excel.Range
'22/09/2013, RB: written as "Function AttemptAtARobustLastCellFinder_v4(ws As Worksheet) As Range" for:
'http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28203209.html#a39474286
'inspired by FP's comments about a "binary chop" approach http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28203209.html#a39380467
'still subject to the limitations of CountA which Qlemo mentioned: http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28203209.html#a39380520

Dim PercentArr As Variant    'this can probably be written better
Dim PercentageMultiplier As Double
Dim PercentInd As Long    'percent loop index
Dim LastRow As Long
Dim LastCol As Long
Dim RowsInWs As Long
Dim ColsInWs As Long
Dim LoopInd As Long
Dim UpperLim As Long
Dim BlockSizer As Long
Dim FirstRowOfUsedRng As Long

    With ws
        RowsInWs = .Rows.Count
        ColsInWs = .Columns.Count
    End With
    PercentArr = Array(0.5, 0.3, 0.1, 0.05, 0.03, 0.01, 0.005, 0.003, 0.001, 1)

    'run a loop to find the last row
    'v4, amended in case the first row of the used range is not Row 1.
    With ws.UsedRange
        UpperLim = Application.WorksheetFunction.Min(RowsInWs, .Cells(1, 1).Row - 1 + .Rows.Count)
    End With

    For PercentInd = LBound(PercentArr) To UBound(PercentArr)

        PercentageMultiplier = PercentArr(PercentInd)
        If PercentageMultiplier <> 1 Then
            BlockSizer = PercentageMultiplier * RowsInWs
        Else
            BlockSizer = 1
        End If

        For LoopInd = UpperLim To 1 Step -BlockSizer
            If (LoopInd - BlockSizer + 1) > 0 Then
                If Application.CountA(ws.Range(LoopInd - BlockSizer + 1 & ":" & LoopInd)) Then
                    Exit For
                End If
            Else
                Exit For
            End If
        Next LoopInd

        UpperLim = LoopInd
    Next PercentInd

    'v4: .max is used to allow for empty sheets
    LastRow = Application.WorksheetFunction.Max(1, UpperLim)

    'run a loop to find the last column
    'v4, amended in case the first column of the used range is not column 1.
    With ws.UsedRange
        UpperLim = Application.WorksheetFunction.Min(ColsInWs, .Cells(1, 1).Column - 1 + .Columns.Count)
    End With
    For PercentInd = LBound(PercentArr) To UBound(PercentArr)

        PercentageMultiplier = PercentArr(PercentInd)
        If PercentageMultiplier <> 1 Then
            BlockSizer = PercentageMultiplier * ColsInWs
        Else
            BlockSizer = 1
        End If

        For LoopInd = UpperLim To 1 Step -BlockSizer
            If (LoopInd - BlockSizer + 1) > 0 Then
                With ws
                    'Searches entire columns
                    'v4 corrected as per http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28203209.html#a39392583
                    If Application.CountA(.Range(.Cells(1, LoopInd - BlockSizer + 1), .Cells(RowsInWs, LoopInd))) Then
                        Exit For
                    End If
                End With
            Else
                Exit For
            End If
        Next LoopInd

        UpperLim = LoopInd
    Next PercentInd

    'v4: .max is used to allow for empty sheets
    LastCol = Application.WorksheetFunction.Max(1, UpperLim)

    '    'User feedback for testing
    Debug.Print "Last row = " & LastRow & vbNewLine & "Last column = " & LastCol & vbNewLine & "Address = '" & ws.Name & "'!" & ws.Cells(LastRow, LastCol).Address
    '    MsgBox "Last row = " & LastRow & vbNewLine & "Last column = " & LastCol & vbNewLine & "Address = '" & ws.Name & "'!" & ws.Cells(LastRow, LastCol).Address

    Set LastCell = ws.Cells(LastRow, LastCol)

End Function

Open in new window


hth
Rob
0
 

Assisted Solution

by:AndreasHermle
AndreasHermle earned 0 total points
ID: 39719046
Hi Rob,

there are no subfolders to be checked. I am impressed with your code. I will give it a try and then let you know. Thank you very much for your professional help.

Regards, Andreas
0
 

Author Comment

by:AndreasHermle
ID: 39719104
Hi Rob,

works like a charm. I am truly impressed. Thank you very much for your professional and superb help.

You asked if subfolders also should be searched. Now it turns out that I got cases where this is the case.

Do you think you could rewrite your code so that it also permits searching in subfolders. That would be great.

Thank you very much, Regards, Andreas
0
 
LVL 10

Expert Comment

by:broro183
ID: 39719582
hi Andreas,


Will it be every excel file in the main "C:\MyData" folder & every excel file in the sub folders too?
If it is always going to be every file that gets processed then I'll change the code so that you don't need to manually select the files. However, if you prefer for the user to do this selection, or if there could be exemptions, then I'll figure out a way to keep the macro looping until all possible sub folders have been viewed/checked/selected from.

Rob
0
 
LVL 10

Expert Comment

by:broro183
ID: 39719832
hi,

Here's a rough & ready version that I have copied & pasted together from other projects. It's still not thoroughly tested, but it did run from start to finish for me. Run the "Delete_NZ_From_ActiveSheet_v3" sub & let me know if I'm on the right track...

Option Explicit

Public glb_origCalculationMode As Long
Public glb_origStatusBar As String
Public FirstTimeListingSubFolders As Boolean
Public ListSubFolders As VbMsgBoxResult
Public ListAllDetails As VbMsgBoxResult
Public fs As Object, f As Object

Sub Delete_NZ_From_ActiveSheet_v3()
'modified from my OpenManyFiles_v2()
Const strPath As String = "C:\MyData"    '"C:\Users\Robert\Documents"
Dim OriPath As String   ' Original path
Dim sFname As Variant
Dim wb As Workbook
Dim ws As Worksheet
Dim LastCll As Range
Dim AFRng As Range
Dim VisRows As Range
Dim i As Long
Dim r As Long

    Call ToggleRefreshXlApp(False)
    'identify the current directory & then change it to the desired path before using getopen filename
    OriPath = CurDir
    ChDir strPath
    'or    ChDir ThisWorkbook.Path
    '    sFname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", MultiSelect:=True)

    'this will delete any existing sheet from previous running of the macro
    If DoesSheetExist("List of Files") Then
        Application.DisplayAlerts = False
        ThisWorkbook.Worksheets("List of Files").Delete
        Application.DisplayAlerts = True
    End If

    Call ListFilesAndFolders

    With ThisWorkbook.Worksheets("List of Files")
        sFname = .Range(.Cells(6, "b"), .Cells(.Cells(.Rows.Count, "b").End(xlUp).Row, "b"))
    End With

    If IsArray(sFname) Then
        For i = LBound(sFname) To UBound(sFname)
            '  test that the file name is for an excel file
            If InStr(1, sFname(i, 1), ".xls") Then
                Set wb = Workbooks.Open(Filename:=sFname(i, 1), UpdateLinks:=False)
                For Each ws In wb.Worksheets
                    Set LastCll = LastCell(ws)
                    With ws
                        'remove any filters & turn the autofilter back on
                        If .AutoFilterMode Then
                            .AutoFilterMode = False
                        End If

                        Set AFRng = .Range(.Cells(1, 1), LastCll)
                        With AFRng
                            .AutoFilter Field:=5, Criteria1:="NZ"
                            'set a range variable to the visible rows after applying the filter, test that some rows exist & delete them
                            On Error Resume Next
                            Set VisRows = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(xlCellTypeVisible).EntireRow
                            On Error GoTo 0
                            If Not VisRows Is Nothing Then
                                VisRows.Delete Shift:=xlUp
                            End If
                            .AutoFilter Field:=5
                        End With
                    End With
                    Set LastCll = Nothing
                    Set VisRows = Nothing
                    Set AFRng = Nothing
                Next ws
                wb.Close True
                Set wb = Nothing
                'do nothing
            End If
        Next i
    End If

    'change back to user's original path
    ChDir OriPath
    Call ToggleRefreshXlApp(True)
    MsgBox "Done"
End Sub

Sub RefreshXlApp()
    With Application
        .EnableEvents = True
        On Error Resume Next
        .Calculation = xlCalculationAutomatic
        On Error GoTo 0
        .StatusBar = False
        .ScreenUpdating = True
        .DisplayFormulaBar = True
        .ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
    End With
End Sub
Sub ToggleRefreshXlApp(RefreshAppSettings As Boolean, Optional ByRef xlApp As Excel.Application)
    If xlApp Is Nothing Then
        Set xlApp = Excel.Application
    End If
    With xlApp
        If Not RefreshAppSettings Then
            glb_origCalculationMode = .Calculation
            glb_origStatusBar = .StatusBar
        End If
        .EnableEvents = RefreshAppSettings
        On Error Resume Next
        '        .Calculation = IIf(RefreshAppSettings, glb_origCalculationMode, xlCalculationManual)
        .Calculation = IIf(RefreshAppSettings, xlCalculationAutomatic, xlCalculationManual)
        On Error GoTo 0
        .StatusBar = IIf(RefreshAppSettings, vbNullString, CBool(glb_origStatusBar))
        .ScreenUpdating = RefreshAppSettings
    End With
    Set xlApp = Nothing
End Sub

Function DoesSheetExist(shtName As String, Optional wkb As Workbook = Nothing) As Boolean
'1/06/2010, sourced from: http://www.excelforum.com/excel-programming/731229-reference-a-sheet-that-may-or-may-not-exist.html
    On Error Resume Next
    DoesSheetExist = Not IIf(wkb Is Nothing, ActiveWorkbook, wkb).Sheets(shtName) Is Nothing
    On Error GoTo 0
End Function


Sub ListFilesAndFolders()
Dim RequestedDirectory As String
Dim N As Long
Dim ConvertToHyperlinks As VbMsgBoxResult
Dim ListingWs As Worksheet

    ''gather user input at start of macro
    'ListSubFolders = MsgBox("Do you want to list the files in the sub folders?", vbYesNo, "LIST THE FILES IN THE SUB FOLDERS?")
    ListSubFolders = vbYes

    'ConvertToHyperlinks = MsgBox("do you want to convert the files listed to hyperlinks?", vbYesNo)
    ConvertToHyperlinks = vbNo

    ''identify if all details are required to be listed - this will be slower.
    'ListAllDetails = MsgBox("Press [yes] to list all details or [no] for just the file & folder names", vbYesNo)
    ListAllDetails = vbNo

    '    Call ToggleRefreshXlApp(False)
    'insert & name a new sheet
    Set ListingWs = ThisWorkbook.Worksheets.Add
    With ListingWs
        .Name = "List of Files"
        .Range(.Cells(5, 1), .Cells(5, 2)) = Array("Folder", "File")
        Select Case ListAllDetails
            Case Is <> vbYes
                'leave blank
            Case Is = vbYes
                .Range(.Cells(5, 3), .Cells(5, 8)) = Array("Size", "Type", "Date Created", "Date Last Accessed", "Date Last Modified", "Attributes")
        End Select
    End With
    'GetFolder is sourced from p 370 & ListFiles sourced from p769 of Excel 2002 Power Programming with VBA
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = CurDir
        .Title = "Please choose folder to list files from"
        .Show
        If .SelectedItems.Count = 0 Then MsgBox "no folder selected": Exit Sub
        RequestedDirectory = .SelectedItems(1)
    End With
    ''The GetSubDirectories subroutine is called recursively using the name of the parent folder.
    Call GetSubDirectories(RequestedDirectory, ListSubFolders)
    ''Hyperlinks (formulae not just cell formatting using [ctrl + k] due to occasional issues) are added to all entries in columns 1 & 2
    ''other background info 3/4's down the following sheet http://www.mvps.org/dmcritchie/excel/sheets.htm
    ''Q: can this be done in one hit w/o looping?
    ''A: appears not!
    With ListingWs
        Select Case ConvertToHyperlinks
            Case Is <> vbYes
                'no action
            Case Is = vbYes
                For N = 6 To .Cells(.Rows.Count, 1).End(xlUp).Row
                    With .Cells(N, 1)
                        .Value = "=hyperlink(" & Chr(34) & .Value & Chr(34) & ", " & Chr(34) & .Value & Chr(34) & ")"
                        With .Offset(0, 1)
                            .Value = "=hyperlink(" & Chr(34) & .Value & Chr(34) & ", " & Chr(34) & .Value & Chr(34) & ")"
                        End With
                    End With
                Next N
        End Select
        .Columns.AutoFit
    End With
    Set fs = Nothing
    Set f = Nothing
    '    MsgBox "done"
    '    Call ToggleRefreshXlApp(True)
End Sub
Sub GetSubDirectories(folderspec, ListSubFolders As VbMsgBoxResult)
Dim SubFolder As Object       'not sure what this sould be?
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(folderspec)
    Call GetFiles(f.Path, ListAllDetails)
    Select Case ListSubFolders
        Case Is = vbYes        'value = 6
            For Each SubFolder In f.SubFolders
                Call GetSubDirectories(SubFolder.Path, ListSubFolders)        'This is a recursive call
            Next SubFolder
        Case Else        'case is = 7 'vbno or False or Case Is = 2 'vbcancel or Cancelled
    End Select
End Sub
Sub GetFiles(folderspec, ListAllDetails As VbMsgBoxResult)
Dim r As Long
Dim file As Object
    ReDim TempArr(1 To 1, 1 To 8) As String
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(folderspec)
    On Error Resume Next
    For Each file In f.Files
        On Error Resume Next
        r = Range("A" & Rows.Count).End(xlUp).Row + 1
        TempArr(1, 1) = folderspec
        TempArr(1, 2) = folderspec & "\" & file.Name
        Select Case ListAllDetails
            Case Is <> vbYes
                'leave blank
            Case Is = vbYes
                With file
                    TempArr(1, 3) = .Size
                    TempArr(1, 4) = .Type
                    TempArr(1, 5) = .DateCreated
                    TempArr(1, 6) = .DateLastAccessed
                    TempArr(1, 7) = .DateLastModified
                    TempArr(1, 8) = .Attributes
                End With
        End Select
        Range(Cells(r, 1), Cells(r, 8)).Value2 = TempArr
        On Error GoTo 0
    Next file
End Sub

Function LastCell(ws As Excel.Worksheet) As Excel.Range
'22/09/2013, RB: written as "Function AttemptAtARobustLastCellFinder_v4(ws As Worksheet) As Range" for:
'http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28203209.html#a39474286
'inspired by FP's comments about a "binary chop" approach http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28203209.html#a39380467
'still subject to the limitations of CountA which Qlemo mentioned: http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28203209.html#a39380520

Dim PercentArr As Variant    'this can probably be written better
Dim PercentageMultiplier As Double
Dim PercentInd As Long    'percent loop index
Dim LastRow As Long
Dim LastCol As Long
Dim RowsInWs As Long
Dim ColsInWs As Long
Dim LoopInd As Long
Dim UpperLim As Long
Dim BlockSizer As Long
Dim FirstRowOfUsedRng As Long

    With ws
        RowsInWs = .Rows.Count
        ColsInWs = .Columns.Count
    End With
    PercentArr = Array(0.5, 0.3, 0.1, 0.05, 0.03, 0.01, 0.005, 0.003, 0.001, 1)

    'run a loop to find the last row
    'v4, amended in case the first row of the used range is not Row 1.
    With ws.UsedRange
        UpperLim = Application.WorksheetFunction.Min(RowsInWs, .Cells(1, 1).Row - 1 + .Rows.Count)
    End With

    For PercentInd = LBound(PercentArr) To UBound(PercentArr)

        PercentageMultiplier = PercentArr(PercentInd)
        If PercentageMultiplier <> 1 Then
            BlockSizer = PercentageMultiplier * RowsInWs
        Else
            BlockSizer = 1
        End If

        For LoopInd = UpperLim To 1 Step -BlockSizer
            If (LoopInd - BlockSizer + 1) > 0 Then
                If Application.CountA(ws.Range(LoopInd - BlockSizer + 1 & ":" & LoopInd)) Then
                    Exit For
                End If
            Else
                Exit For
            End If
        Next LoopInd

        UpperLim = LoopInd
    Next PercentInd

    'v4: .max is used to allow for empty sheets
    LastRow = Application.WorksheetFunction.Max(1, UpperLim)

    'run a loop to find the last column
    'v4, amended in case the first column of the used range is not column 1.
    With ws.UsedRange
        UpperLim = Application.WorksheetFunction.Min(ColsInWs, .Cells(1, 1).Column - 1 + .Columns.Count)
    End With
    For PercentInd = LBound(PercentArr) To UBound(PercentArr)

        PercentageMultiplier = PercentArr(PercentInd)
        If PercentageMultiplier <> 1 Then
            BlockSizer = PercentageMultiplier * ColsInWs
        Else
            BlockSizer = 1
        End If

        For LoopInd = UpperLim To 1 Step -BlockSizer
            If (LoopInd - BlockSizer + 1) > 0 Then
                With ws
                    'Searches entire columns
                    'v4 corrected as per http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28203209.html#a39392583
                    If Application.CountA(.Range(.Cells(1, LoopInd - BlockSizer + 1), .Cells(RowsInWs, LoopInd))) Then
                        Exit For
                    End If
                End With
            Else
                Exit For
            End If
        Next LoopInd

        UpperLim = LoopInd
    Next PercentInd

    'v4: .max is used to allow for empty sheets
    LastCol = Application.WorksheetFunction.Max(1, UpperLim)

    '    'User feedback for testing
    Debug.Print "Last row = " & LastRow & vbNewLine & "Last column = " & LastCol & vbNewLine & "Address = '" & ws.Name & "'!" & ws.Cells(LastRow, LastCol).Address
    '    MsgBox "Last row = " & LastRow & vbNewLine & "Last column = " & LastCol & vbNewLine & "Address = '" & ws.Name & "'!" & ws.Cells(LastRow, LastCol).Address

    Set LastCell = ws.Cells(LastRow, LastCol)
End Function

Open in new window


hth
Rob
0
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 

Author Comment

by:AndreasHermle
ID: 39720356
Hi Rob,

wow, the code keeps growing and growing ... Incredible. I'll do some testing soon and then let you know. Regards, Andreas.

thank you very much for your superb help.

Regards, andreas
0
 
LVL 10

Expert Comment

by:broro183
ID: 39720895
hi Andreas,

hmmm, more code doesn't necessarily mean better!
It could be written a lot better, some of the reason that this is so long is purely because I copied & pasted from my old work & haven't made it streamlined.

Let me know how your testing goes.

Rob
0
 

Author Comment

by:AndreasHermle
ID: 39721911
Hi Rob,

it is throwing an error message on line 118: A modul has a type that is not permitted (translated from English).

Rob, you know what, do not bother to trap the error / adjust the code. I am so happy with the first code you sent me (it is superfast), i.e. the one that does not do subfolders. As a matter of fact, I can easily circumvent this problem.

Again thank you very much for your great help.

Regards, Andreas
0
 
LVL 10

Expert Comment

by:broro183
ID: 39722349
hi Andreas,

I'm just guessing here, do you have the code in a "sheet module"?

If you move all the code to a "normal" module I think the error will stop occurring.

Rob
0
 

Author Comment

by:AndreasHermle
ID: 39724067
I normally never integrate codes into a sheet module, but I will double check ...
0
 

Author Comment

by:AndreasHermle
ID: 39728660
Hi Rob, nope, sorry, I did not integrate it into a sheet module.

Anyway, you deserve most of the points for your first macro you provided. It works like a charm.

Regards, Andreas
0
 
LVL 10

Expert Comment

by:broro183
ID: 39729013
Mod's: This post is not an objection.

hi Andreas,
I'm sorry I can't help more... but I don't want to give up yet.
Is line 118 which is erroring the one that  states "Function DoesSheetExist(shtName As String, Optional wkb As Workbook = Nothing) As Boolean"?
Does the code compile when you put it into the VBE & then press [alt + d + l]?
I'd like to see if I can replicate the error message. What language are you using in your Regional & Language Settings (an option within the Control Panel)?


Rob
0
 

Author Closing Comment

by:AndreasHermle
ID: 39735730
Dear both,

this forum is so great. I have never walked away from this forum without a very good solution.
Thank you very much for your great and professional help.

Regards, Andreas
0
 
LVL 10

Expert Comment

by:broro183
ID: 39735749
Thank you for the points Andreas :-)
0
 

Author Comment

by:AndreasHermle
ID: 39737538
Hi Rob,

thank you very much for your post about not giving up.

I will re-test over the coming days and then let you know.

Regards, Andreas
0

Featured Post

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
Approximate matching with VLOOKUP and MATCH seems to me to be a greatly under-used technique, and one which is vital for getting good performance out of large lookups. Until recently I would always have advised using an exact match for simplicity an…
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now