Hello, I'm trying to implement a macro that would loop trough files in a folder you can select every time the macro is ran. Maybe someone could Help? I am not that familiar with code yet. The main task for it is to paste special the all the sheets (Some don't need) so that the formula disappears and after that delete columns N and forward and then move to the next workbook until it's done
Task explained:
I got a file of multiple (50) Excels that should sent to customers. For each one now I have pasted special so that the formula is removed from the cells and after that deleted unnecessary columns with sensitive information like pricing or notes. I would need the macro to first open a workbook in the selected folder. Then paste special (formula removed from whole sheet) and do that for each sheet in workbook with few exceptions. After that repeat the process but for deleting columns from N - AA for each sheet. After that close workbook and repeat for all files in the selected file.
Here's some macros that I like and could be useful (Maybe combining them and making them compatible with each other would work?):
Dim strPath As String
Dim xStrFile1, xStrFile2 As String
Dim xWbk As Workbook
Dim xSFD, xRFD As FileDialog
Dim xSPath As String
Dim xRPath, xWBName As String
Dim xBol As Boolean
Set xSFD = Application.FileDialog(msoFileDialogFolderPicker)
With xSFD
.Title = "Please select the folder contains the Excel files you want to convert:"
.InitialFileName = "C:\"
End WithDisplay Less
Code: Avoiding certain sheet names
Sub Sheet_ExportPDF(wb As Workbook, fname As String)
'Purpose: determine sheets to be exported to pdf
'store base workbook name
Dim baseWB As String
baseWB = fname
'user to define what names to avoid by adding to string
Const NTA As String = "Byers_Green_hinnasto,Var_Str_Cev_hinnasto,Hinnasto, 0.0.2022, 00.01.1900, Client Unspecified-13, Toll-hinnasto, Ei käytössä2, Ei käytössä, Ajot_01, Ajot_02, Ajot_03, Ajot_03, Ajot_04, Ajot_05, Ajot_06, Ajot_07, Ajot_08, Ajot_09, Ajot_10, Ajot_11, Ajot_12, Steveco"
'build array of names to avoid
Dim NamesToAvoid As Variant
NamesToAvoid = Split(NTA, ",")
'process visible worksheets and compare to NamesToAvoid, export the
'sheets that are not in conflict with user's list to avoid
Dim ws As Worksheet, blnConflict As Boolean, i As Long
For Each ws In wb.Worksheets
'determine if sheet is visible
If ws.Visible = xlSheetVisible Then
'loop through user's list to avoid
For i = LBound(NamesToAvoid) To UBound(NamesToAvoid)
'if on the avoidance list, set bln and exit loop
If UCase(ws.Name) = Trim(UCase(NamesToAvoid(i))) Then
blnConflict = True
Exit For
End If
Next i
'process appropriate safe sheets
fname = baseWB & "_" & ws.Name & ".pdf"
If Not blnConflict Then ExportPDF ws, fname Else blnConflict = False
End If
Next ws
End SubSub RemoveFormulas()
'This will copy/paste all values in the entire workbook (with option for hidden sheets)
Application.ScreenUpdating = False
Dim Sh As Worksheet
Dim Q1, Q2 As Integer
Q1 = MsgBox("Would you like to remove all formulas from this workbook?", _
vbQuestion + vbYesNo)
If Q1 = vbNo Then Exit Sub
If Q1 = vbYes Then Q2 = MsgBox("Would you like to include hidden worksheets?", _
vbQuestion + vbYesNo)
If Q2 = vbYes Then
For Each Sh In ActiveWorkbook.Worksheets
Sh.Activate
Sh.Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Sh.Range("A1").Select
Next Sh
End If
If Q2 = vbNo Then
For Each Sh In ActiveWorkbook.Worksheets
If Sh.Visible = True Then
Sh.Activate
Sh.Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Sh.Range("A1").Select
End If
Next Sh
End If
Application.CutCopyMode = False
Application.ScreenUpdating = True
End SubSub LoopAllFilesInFolder()Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
myPath = "your path\"
myExtension = "*.xls*"
myFile = Dir(myPath & myExtension)
Do While myFile <> ""
If Len(myFile) = 0 Then Exit Do
Set wb = Workbooks.Open(Filename:=myPath & myFile)
Columns("R:S").EntireColumn.Delete
wb.Close SaveChanges:=True
myFile = Dir
Loop
'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub