I need help with Combining VBA code. Im not sure how to properly combine. Thanks

RyanHawkeye

New Member
Joined
Apr 9, 2015
Messages
48
Option Explicit
Sub KeepSpecificSheets()
Dim FolderPath As String
Dim Filename As String
Dim wb As Workbook
Dim ws As Worksheet
Dim MasterWorkbook As Workbook
Dim KeepSheets As Object
Dim wsName As String
Dim FoundSheet As Boolean

Application.DisplayAlerts = False

' Set the folder path

FolderPath = "C:\Your\Folder\Path\" ' Change this to your folder path

If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"

' Store the master workbook

Set MasterWorkbook = ThisWorkbook

' Define sheets to keep in a dictionary

Set KeepSheets = CreateObject("Scripting.Dictionary")

KeepSheets.Add "AR20", True
KeepSheets.Add "AR21", True
KeepSheets.Add "VT77", True
KeepSheets.Add "GG65", True


' Loop through all xlsx files in the folder
Filename = Dir(FolderPath & "*.xlsx")
Do While Filename <> ""
' Open the workbook if it is not the master workbook
If StrComp(FolderPath & Filename, MasterWorkbook.FullName, vbTextCompare) <> 0 Then
Set wb = Workbooks.Open(FolderPath & Filename)
FoundSheet = False ' Initialize flag

' Check if any sheets to keep exist
For Each ws In wb.Worksheets
If KeepSheets.exists(ws.Name) Then
FoundSheet = True
Exit For
End If
Next ws

' If no sheets match the keep list, delete the workbook
If Not FoundSheet Then
Application.DisplayAlerts = False
wb.Close SaveChanges:=False ' Close without saving changes
Kill FolderPath & Filename ' Delete the file
Application.DisplayAlerts = True
Else
' Loop through all worksheets in the workbook to delete non-matching sheets

For Each ws In wb.Worksheets
wsName = ws.Name
If Not KeepSheets.exists(wsName) Then
Application.DisplayAlerts = False
ws.Visible = xlSheetVisible ' Make sheet visible if hidden
ws.Delete
Application.DisplayAlerts = True
End If
Next ws

Application.DisplayAlerts = False
' Save and close the workbook
wb.Close SaveChanges:=True
Application.DisplayAlerts = True
End If
End If

' Get the next file
Filename = Dir
Loop

Application.DisplayAlerts = True

MsgBox "Process Completed!", vbInformation
End Sub



/****************************************************************************************/

/***************************************************************************************/


COMBINE VBA Above to the VBA Below so it runs as one Code

/****************************************************************************************/

/****************************************************************************************/


'WB: The workbook you want to change the Sensitivity on

'LblName: General

' Public

' Internal Use

' Confidential

' Restricted

Function SetSensitivityLabel(WB As Workbook, LblName As String)

Dim myLabelInfo As Office.LabelInfo

Dim Context As Variant

Dim objWorkbook As Workbook

Dim CurLabelID As String



Dim sPublic As String

Dim sGeneral As String

Dim sInternal_Use As String

Dim sConfidential As String

Dim sRestricted As String



Set objWorkbook = ActiveWorkbook

Set myLabelInfo = objWorkbook.SensitivityLabel.CreateLabelInfo()

Set Context = CreateObject("Scripting.Dictionary")



sPublic = "174b6716-c2ea-4041-b631-5633733fbe46-8420s"

sInternal_Use = "1f9c9bcd-f315-4c3b-87a0-7682e230e7e4-8420z"

sConfidential = "eb0be65c-43df-47d1-8c45-69f1d3d476a9-8420p"

sRestricted = "48d9d89d-06ce-4535-b1a5-059e3329e9c8-8420n"





Select Case LblName

Case "General"

CurLabelID = sGeneral

Case "Public"

CurLabelID = sPublic

Case "Internal Use"

CurLabelID = sInternal_Use

Case "Confidential"

CurLabelID = sConfidential

Case "Restricted"

CurLabelID = sRestricted



End Select



With myLabelInfo

.AssignmentMethod = MsoAssignmentMethod.PRIVILEGED '1

.ContentBits = 4

.IsEnabled = True

.Justification = "Because" 'Make this whatever you want

.LabelId = CurLabelID

.LabelName = LblName

.SetDate = Now()

End With

objWorkbook.SensitivityLabel.SetLabel myLabelInfo, Context

End Function



/*** The below Part identifies the Sensitivity IDs for sPublic, sInternal Use, sConfidential, and sRestricted that I have manually put in the code above ****/

Sub GetSensitivityID()

Dim myLabelInfo As Office.LabelInfo

Set myLabelInfo = ActiveWorkbook.SensitivityLabel.GetLabel()

Debug.Print myLabelInfo.LabelId



End Sub

/****** The below is the END GOAL of the VBA above to change the Label of the Spreadsheet to what you want it to be ****/

Sub SetSLabel()

SetSensitivityLabel ActiveWorkbook, "Confidential"

End Sub
 
Instead of combining the code, an easy solution is to run both macros from one new macro...

VBA Code:
Sub KeepAndSet()

Call KeepSpecificSheets
Call SetSLabel

End Sub
 
Upvote 0
Instead of combining the code, an easy solution is to run both macros from one new macro...

VBA Code:
Sub KeepAndSet()

Call KeepSpecificSheets
Call SetSLabel

End Sub
Thank You.....I will try this out when I get a chance. Just got an avalanche of stuff thrown at me today.
 
Upvote 0

Forum statistics

Threads
1,226,907
Messages
6,193,601
Members
453,810
Latest member
Gks77117

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