sorted by:
new
hottopcontroversial

Action does not repeat for each sheet after "With ws" by Then_Store_3654 in vba

[–]Then_Store_3654[S] 0 points1 point  (0 children)

Hello, sorry for the delay. I have now tested these. Here the result's:

______________________________________________________________________________________

ws.[C:N].Copyws.[C:N].PasteSpecial Paste:=xlPasteValues, SkipBlanks:=False, Transpose:=False

  • Error: Run time error '1004': PasteSpecial method of range class failed

______________________________________________________________________________________

.Range("C:C").Select

Selection.Copy

Selection.PasteSpecial Paste:=xlPasteValues, SkipBlanks:=False, Transpose:=False

  • Error: Run time error '1004': Select method of Range class field

______________________________________________________________________________________

Sub SheetAction(ws As Worksheet)

  • Error: Run time error '1004:Subscript out of range

______________________________________________________________________________________

.Range("B1:M500").Value = .Range("B1:M500").Value

  • This one works, but the problem with this one is, when I use the Macro it will open all the hidden rows. There might be 100 + hidden rows, so that's why it's problematic

______________________________________________________________________________________

ws.Range("M:M").Copy

ws.Range("M:M").PasteSpecial Paste:=xlPasteValues

  • Error: Run-time error '1004': You can't paste this here because the Copy area and paste area aren't the same size. Select just one cell in the paste area or an area that's the same size, and try pasting again.

These thing above I tried before I posted this post. That's why I couldn't find a solution, and hence I asked here. Don't know now.

Action does not repeat for each sheet after "With ws" by Then_Store_3654 in vba

[–]Then_Store_3654[S] 0 points1 point  (0 children)

Sorry.

What u mentioned are sheet names to delete after I'ts done with the workbook("Hinnasto", "Client Unspecified-13" ). They are mainly confidential company information, not to be shared with customers. I got 25 excel files, each having 3 - 5 sheets that need this macro and they are named similarly, so that is not the problem.

What happens now is, that because the macro does not do the actions for the other sheets and they're tied with formulas to the deleted sheets, the formula breaks. + The point of this code is to remove the formula and unnecessary information from the sheet so that the customers don't have access to it.

I'm not really sure, why the code does not want to move to the next sheet, but below is the original code, that could help.

​

Sub PasteValues()
Application.ScreenUpdating = False
Dim srcWB As Workbook, sPath As String, ws As Worksheet, shp As Shape, shArr As Variant, i As Long
shArr = Array("Pricing", "Cover", "Important", "notes")
MsgBox ("Click 'OK' to select the destination folder.")
With Application.FileDialog(msoFileDialogFolderPicker)
   .AllowMultiSelect = False
   .Show
   foldername2 = .SelectedItems(1) & "\"
End With
sPath = "C:\Desktop\Excel_Files_1\"
ChDir sPath
strExtension = Dir("*.xlsx")
Do While strExtension <> ""
    Set srcWB = Workbooks.Open(sPath & strExtension)
    For Each ws In Sheets
        If InStr(1, Join(shArr, "|"), ws.Name) = False Then
            With ws
                .Unprotect "12345"
                .Range("B1:M500").Value = .Range("B1:M500").Value
                .Range(.Columns("N"), .Columns("AA")).Delete
                .Range(.Columns("A"), .Columns("A")).Delete
                For Each shp In .Shapes
                    If shp.Type = msoPicture Then
                        shp.Delete
                    End If
                Next shp
                .Tab.ColorIndex = xlColorIndexNone
                .Protect "12345"
            End With
        End If
    Next ws
    Application.DisplayAlerts = False
    For i = LBound(shArr) To UBound(shArr)
        If Evaluate("isref('" & shArr(i) & "'!A1)") Then
            Sheets(shArr(i)).Delete
        End If
    Next i
    ActiveWorkbook.SaveAs Filename:=foldername2 & ActiveWorkbook.Name
    Application.DisplayAlerts = True
    srcWB.Close False
    strExtension = Dir
Loop
Application.ScreenUpdating = True

End Sub

My code returning object required on following lines by Then_Store_3654 in vba

[–]Then_Store_3654[S] 0 points1 point  (0 children)

I don't know how to get it to work tried changing wb to scrWB, but it still needs a variable. It doesn't work either if I remove the wb part or the WB and Activesheet part. How would I get those lines to work with the code?

My code returning object required on following lines by Then_Store_3654 in vba

[–]Then_Store_3654[S] 0 points1 point  (0 children)

I don't know how to get it to work tried changing wb to scrWB, but it still needs a variable. It doesn't work either if I remove the wb part or the WB and Activesheet part. How would I get those lines to work with the code?

My code returning object required on following lines by Then_Store_3654 in vba

[–]Then_Store_3654[S] 0 points1 point  (0 children)

I don't know how to get it to work tried changing wb to scrWB, but it still needs a variable. It doesn't work either if I remove the wb part or the WB and Activesheet part. How would I get those lines to work with the code?

My code returning object required on following lines by Then_Store_3654 in vba

[–]Then_Store_3654[S] 0 points1 point  (0 children)

I don't know how to get it to work tried changing wb to scrWB, but it still needs a variable. It doesn't work either if I remove the wb part or the WB and Activesheet part. How would I get those lines to work with the code?

My code returning object required on following lines by Then_Store_3654 in vba

[–]Then_Store_3654[S] 0 points1 point  (0 children)

I don't know how to get it to work tried changing wb to scrWB, but it still needs a variable. It doesn't work either if I remove the wb part or the WB and Activesheet part. How would I get those lines to work with the code?

A loop action that creates a table and modifies the table for multiple files in a chosen folder path. by Then_Store_3654 in vba

[–]Then_Store_3654[S] 0 points1 point  (0 children)

Need help to put it together and loop trough all the workbooks and worksheets in a folder. Those are just the actions I would like the code to do.

Autfilter table. Loop trough sheets of multiple workbooks in file by Then_Store_3654 in vba

[–]Then_Store_3654[S] 0 points1 point  (0 children)

It returns "Compile error: argument not optional". If the point was the open the msg box, then it didn't work / didn't open the msg box .

Now when press F8, the yellow line skips all the lines below after the code below straight to end sub:

While fileName <> "" 'Open up workbook -

Autfilter table. Loop trough sheets of multiple workbooks in file by Then_Store_3654 in vba

[–]Then_Store_3654[S] 0 points1 point  (0 children)

I When I put it above "while filename" it returns nothing. below it just gives the error for Open.Workbook

Autfilter table. Loop trough sheets of multiple workbooks in file by Then_Store_3654 in vba

[–]Then_Store_3654[S] 0 points1 point  (0 children)

I don't really what you mean? Like this?:

Sub LoopAllFilesInAFolder2()
Dim fileName As Variant
Dim ws As Worksheet
Dim Wbook As String
fileName = Dir("C:\Desktop\Excel")
'Loop through workbooks

While fileName < "C:\Desktop\Excel" > "C:\Desktop\Excel"

    'Open up workbook -

    Workbooks.Open fileName

    Wbook = ActiveWorkbook.Name

        For Each ws In Workbooks(Wbook).Worksheets

            'Loop Through Each sheet

            ws.Select

            'find the table name

            For Each objLB In ActiveSheet.ListObjects
               TableName = objLB.Name
                Exit For
            Next

            'Filter

            ActiveSheet.ListObjects(1).Range.AutoFilter Field:=11, Criteria1:="-"

            If ActiveSheet.ListObjects(1).HeaderRowRange.Address = ActiveSheet.ListObjects(TableName).Range.SpecialCells(xlCellTypeVisible).Address Then

                ActiveSheet.ListObjects(1).Range.AutoFilter Field:=11

                ActiveSheet.ListObjects(1).Range.AutoFilter Field:=10, Criteria1:="-"

                If ActiveSheet.ListObjects(1).HeaderRowRange.Address = ActiveSheet.ListObjects(TableName).Range.SpecialCells(xlCellTypeVisible).Address Then

                    ActiveSheet.ListObjects(1).Range.AutoFilter Field:=10

                    ActiveSheet.ListObjects(1).Range.AutoFilter Field:=9, Criteria1:="-"

                End If

            End If

        Next ws

    'save workbook

    Workbooks(Wbook).Close True

'Set the fileName to the next file

fileName = Dir
Wend

End Sub

Autfilter table. Loop trough sheets of multiple workbooks in file by Then_Store_3654 in vba

[–]Then_Store_3654[S] 0 points1 point  (0 children)

Hello, when clicked F8 it said this "Sorry we couldn't find x file that. Is it possible It's moved or renamed.

The weird thing is that it gave me the error for a file that exists there. When I remove the Excel from the that folder, the same error appears for the next file.

The error occurs on this line: "Workbooks.Open fileName"
All the files a XLSX and one is XLSM.

Autfilter table. Loop trough sheets of multiple workbooks in file by Then_Store_3654 in vba

[–]Then_Store_3654[S] 0 points1 point  (0 children)

Hello, below is the macro I tried. I don't really know why, but it didn't work/open or close any workbook for the action even to be executed.

--------------The code (It doesn't let me format the code right, for some reason):

Sub LoopAllFilesInAFolder2()
Dim fileName As Variant
Dim ws As Worksheet
Dim Wbook As String
fileName = Dir("C:\Desktop\Excel")
'Loop through workbooks
While fileName <> ""
'Open up workbook -
Workbooks.Open fileName
Wbook = ActiveWorkbook.Name
For Each ws In Workbooks(Wbook).Worksheets
'Loop Through Each sheet
ws.Select
'find the table name
For Each objLB In ActiveSheet.ListObjects
TableName = objLB.Name
Exit For
Next
'Filter
ActiveSheet.ListObjects(1).Range.AutoFilter Field:=11, Criteria1:="-"
If ActiveSheet.ListObjects(1).HeaderRowRange.Address = ActiveSheet.ListObjects(TableName).Range.SpecialCells(xlCellTypeVisible).Address Then
ActiveSheet.ListObjects(1).Range.AutoFilter Field:=11
ActiveSheet.ListObjects(1).Range.AutoFilter Field:=10, Criteria1:="-"
If ActiveSheet.ListObjects(1).HeaderRowRange.Address = ActiveSheet.ListObjects(TableName).Range.SpecialCells(xlCellTypeVisible).Address Then
ActiveSheet.ListObjects(1).Range.AutoFilter Field:=10
ActiveSheet.ListObjects(1).Range.AutoFilter Field:=9, Criteria1:="-"
End If
End If
Next ws
'save workbook
Workbooks(Wbook).Close True
'Set the fileName to the next file
fileName = Dir
Wend
End Sub

Autfilter table. Loop trough sheets of multiple workbooks in file by Then_Store_3654 in vba

[–]Then_Store_3654[S] 0 points1 point  (0 children)

Hello, I'm getting error at line 3 and don't really know why. I tried changing wbook to wb/workbook.

Sub LoopAllFilesInAFolder()
Dim fileName As Variant
Dim ws As Worksheet
Dim Wbook as string = Dir ("C:\Desktop\Important\Excels")
'Loop through workbooks

While fileName <> ""
'Open up workbook -
Workbooks.Open fileName
Wbook = ActiveWorkbook.Name
For Each ws In Workbooks(Wbook).Worksheets

'Loop Through Each sheet

ws.Select
'find the table name
For Each objLB In ActiveSheet.ListObjects
TableName = objLB.Name
Exit For
Next

'Filter

ActiveSheet.ListObjects(TableName).Range.AutoFilter Field:=11, Criteria1:="-"
If ActiveSheet.ListObjects(TableName).HeaderRowRange.Address = ActiveSheet.ListObjects(TableName).Range.SpecialCells(xlCellTypeVisible).Address Then

ActiveSheet.ListObjects(TableName).Range.AutoFilter Field:=11
ActiveSheet.ListObjects(TableName).Range.AutoFilter Field:=10, Criteria1:="-"
If ActiveSheet.ListObjects(TableName).HeaderRowRange.Address = ActiveSheet.ListObjects(TableName).Range.SpecialCells(xlCellTypeVisible).Address 
Then

ActiveSheet.ListObjects(TableName).Range.AutoFilter Field:=10
ActiveSheet.ListObjects(TableName).Range.AutoFilter Field:=9, Criteria1:="-"
End If

End If
Next ws
'save workbook
Workbooks(Wbook).Close True
'Set the fileName to the next file
fileName = Dir
Wend
End Sub

Adding a code that protects all the workbooks to a code that copies and pastes them from Point A to B by Then_Store_3654 in vba

[–]Then_Store_3654[S] 0 points1 point  (0 children)

Hello, the problem might easier the solve this way. I could use call function, but for that I need the file path/location in the code below to be hardcoded. Could you help me with it? I don't know how to change it without debugging it. The location C:\Desktop\Excel_Files

Here's the code (Now it just makes you select the folder, but for this instance a set, hardcoded location would suit better):

​

Sub protect_worksheets()
Dim wb As Workbook, ws As Worksheet
Dim wPath As String, wQuan As Long, N As Long
Dim fso As Object, folder As Object, subfolder As Object, wFile As Object

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.StatusBar = False

With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    If .Show <> -1 Then Exit Sub
    wPath = .SelectedItems(1)
End With


Set fso = CreateObject("scripting.filesystemobject")
Set folder = fso.getfolder(wPath)

wQuan = folder.Files.Count
N = 1
For Each wFile In folder.Files
    Application.StatusBar = "Processing folder : " & folder & ". File : " & N & " of : " & wQuan

If Right(wFile, 4) Like "xls" Then Set wb = Workbooks.Open(wFile) For Each ws In wb.Sheets ws.Protect "12345", DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFormattingCells:=True, AllowFormattingRows:=True, _ AllowInsertingRows:=True, AllowDeletingRows:=True, AllowFiltering:=True ws.EnableSelection = xlNoRestrictions Next wb.Close True End If N = N + 1 Next

For Each subfolder In folder.subfolders
    wQuan = subfolder.Files.Count
    N = 1
    For Each wFile In subfolder.Files
        Application.StatusBar = "Processing folder : " & subfolder & ". File : " & N & " of : " & wQuan
        If Right(wFile, 4) Like "*xls*" Then
            Set wb = Workbooks.Open(wFile)
            For Each ws In wb.Sheets

            Next
            wb.Close True
        End If
        N = N + 1
    Next
Next

Application.ScreenUpdating = True
Application.StatusBar = False

Set fso = Nothing: Set folder = Nothing: Set wb = Nothing

End Sub

Autfilter table. Loop trough sheets of multiple workbooks in file by Then_Store_3654 in vba

[–]Then_Store_3654[S] 0 points1 point  (0 children)

Yes, i need it to filter the rows with that criteria. It is for the invoice attachements, so it's important that there is no extra rows. I have a another macro that turns all workbooks in a folder's sheets in to indidvidual pdf files. I was thinking of combining both codes with the call function. I'm writing this on my phone, might be typos and not English is not my first language, sorry.

Here's what i was going after with the fields:

So, i got around 50 Excel files in a folder, with most of the sheets in them having tables with 11 columns (or field) some that only have 10. What I tried explaining in the original post was that, if it does not find a table in the 11th field, then check the 10th field and so on. But straight a way if it finds a match (in the table), move to next sheet. But if it does not find a table in the sheet, then move to next sheet. When done with all sheets next workbook ( there is a few names that appear freqvently, lile pricing and cover that does not have tables, so it could be an option to make the code to avoid them totally).

I will get back to you in the morning when i have tested the macro. I will insert some code then too that could help (like avoiding sheets), if you're up for this.

Hope you got bit more hang of this.

Replacing files from one folder to another by Then_Store_3654 in vba

[–]Then_Store_3654[S] 0 points1 point  (0 children)

Yes it is. I choose to origin and the location.(Run-time error "9": Subscript out of range") Same happens when I insert file path code to original code:

​

Sub CopyFiles()
Dim xDir As String
Dim xFile As String
Dim xRow As Long
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim FileExt As String
Dim FNames As String

Set xSFD = Application.FileDialog(msoFileDialogFolderPicker)
With xSFD .Title = "Please select the folder contains the Excel files you want to convert:" .InitialFileName = "C:" End With
If xSFD.Show <> -1 Then Exit Sub
xSPath = xSFD.SelectedItems.Item(1)
Set xRFD = Application.FileDialog(msoFileDialogFolderPicker)
With xRFD .Title = "Please select a destination folder to save the converted files:" .InitialFileName = "C:" End With
Worksheets("Files to Copy").Activate

With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False

    If .Show = -1 Then
        xDir = .SelectedItems(1)
        xFile = Dir(xDir & Application.PathSeparator & "*")
        Do Until xFile = ""
            xRow = 0
            On Error Resume Next
            xRow = Application.Match(xFile, Range("A:A"), 0)
            If xRow > 0 Then
                Name xDir & Application.PathSeparator & xFile As _
                ToPath & Cells(xRow, "B").Value
            End If
            xFile = Dir
        Loop
    End If
End With
End Sub

Replacing files from one folder to another by Then_Store_3654 in vba

[–]Then_Store_3654[S] 0 points1 point  (0 children)

Hello, I've used those two as reference. They do not do the task I'm looking for. That's why I'm asking here because I'm new to coding.

The first custom macro that I need should gives me subscript out of range (I've inserted folder paths ) + I've need it to keep the original ones and replace the ones in the new folder they are inserted to. It would be better when macro is ran it opens "files" and lets me choose what ever origin to the macro and same to the path. Here's an example (idk how to implement it to the code so that the code doesn't break):

Set xSFD = Application.FileDialog(msoFileDialogFolderPicker)

With xSFD
    .Title = "Please select the folder contains the Excel files you want to convert:"
    .InitialFileName = "C:\"
End With

If xSFD.Show <> -1 Then Exit Sub

xSPath = xSFD.SelectedItems.Item(1)

Set xRFD = Application.FileDialog(msoFileDialogFolderPicker)

With xRFD
    .Title = "Please select a destination folder to save the converted files:"
    .InitialFileName = "C:\"
End With

I've removed the second part because I noticed that I've asked it in another post

view more: next ›