Solved: How to combined Modul

[halimi1306]

Hi Pals,

How to combine moduls into single module? Below are my code for your reference.

Code 1:


Option Explicit
Public Sub ImportSheetData()
Dim sFld As String, sFlPath As String, sFile As String
Dim vPath As Variant
Dim wb As Workbook, wbThisBk As Workbook
Dim ws As Worksheet
Dim i As Integer
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'For calling the deletion sub
Call DeleteOldSheets
Set wbThisBk = ThisWorkbook
'Getting the path
sFlPath = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
If sFlPath = "False" Then
MsgBox "No Files Selected"
Exit Sub
Else
vPath = Split(sFlPath, "\")
sFld = ""
For i = LBound(vPath) To UBound(vPath)
If InStr(1, vPath(i), ".xls") = 0 Then
sFld = sFld & vPath(i) & "\"
End If
Next i
ChDir sFld
sFile = Dir("*.xls*")
Do While sFile <> ""
Set wb = Workbooks.Open(sFld & sFile)
For Each ws In wb.Sheets
ws.Copy Before:=wbThisBk.Sheets("End")
Next ws
wb.Close False
sFile = Dir
Loop
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Private Sub DeleteOldSheets()
'Deleting old worksheets except Model Engine, Guidelines, Macro Control, Summary Dashboard and End
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
Select Case ws.Name
Case "Model Engine (Read Only)", "Guidelines (Read Only)", "Macro Control (Read Only)", "Summary Dashboard", "End"
'do nothing
Case Else
ws.Delete
End Select
Next ws
End Sub

Code 2:

Sub SortWorksheets()

Dim N As Integer
Dim M As Integer
Dim FirstWSToSort As Integer
Dim LastWSToSort As Integer
Dim SortDescending As Boolean


SortDescending = False

If ActiveWindow.SelectedSheets.Count = 1 Then

'Change the 1 to the worksheet you want sorted first
FirstWSToSort = 1
LastWSToSort = Worksheets.Count
Else
With ActiveWindow.SelectedSheets
For N = 2 To .Count
If .Item(N - 1).Index <> .Item(N).Index - 1 Then
MsgBox "You cannot sort non-adjacent sheets"
Exit Sub
End If
Next N
FirstWSToSort = .Item(1).Index
LastWSToSort = .Item(.Count).Index
End With
End If

For M = FirstWSToSort To LastWSToSort
For N = M To LastWSToSort
If SortDescending = True Then
If UCase(Worksheets(N).Name) > UCase(Worksheets(M).Name) Then
Worksheets(N).Move Before:=Worksheets(M)
End If
Else
If UCase(Worksheets(N).Name) < UCase(Worksheets(M).Name) Then
Worksheets(N).Move Before:=Worksheets(M)
End If
End If
Next N
Next M

Sheets("Guidelines (Read Only)").Move Before:=Sheets(1)
Sheets("Macro Control (Read Only)").Move After:=Sheets(1)
Sheets("Summary Dashboard").Move After:=Sheets(2)
Sheets("Model Engine (Read Only)").Move After:=Sheets(3)

End Sub


Code3:

Sub DeleteOldData()
'
' DeleteOldData Macro
'
'
Sheets("Model Engine (Read Only)").Select
ActiveCell.Offset(-5562, 0).Rows("1:5848").EntireRow.Select
Selection.Delete Shift:=xlUp
End Sub

Code 4:

Sub AllDataToForthSheet()
Application.ScreenUpdating = False
Dim SheetCtr As Double
Dim Last1Row As Double
Dim LastShtRow As Double
With ActiveWorkbook
For SheetCtr = 5 To .Sheets.Count
With .Worksheets(SheetCtr)
LastShtRow = .Cells(Rows.Count, "D").End(xlUp).Row
If .Cells(Rows.Count, "J").End(xlUp).Row > LastShtRow Then
LastShtRow = .Cells(Rows.Count, "G").End(xlUp).Row
End If
End With
With .Worksheets(4)
Last1Row = .Cells(Rows.Count, "F").End(xlUp).Row
If .Cells(Rows.Count, "G").End(xlUp).Row > Last1Row Then
Last1Row = .Cells(Rows.Count, "J").End(xlUp).Row
End If
End With
.Worksheets(SheetCtr).Range("D25:S" & LastShtRow).Copy
.Worksheets(4).Range("F" & Last1Row + 1).PasteSpecial xlPasteValues
Next SheetCtr
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub


Thanks. :):):)

[shrivallabha]

It is little confusing as to what do you want to achieve.
1. All of the above are sub-routines which perform some activity are present in different modules (containers) like module1, module2 and you want to compile them all together in a single container. You can do this by doing simple cut and paste across modules and later delete empty modules.

Or

2. Each one of them is a part of one code which lets you achieve what you are setting out to do so now you want to combine all sub-routines to create one code which will do this activity in one go.

Or still something different?

[halimi1306]

Hi Shrivallabha,

My objective is that I want to do in one go.

[Kenneth Hobs]

As shrivallabha (http://www.vbaexpress.com/forum/member.php?u=27076) said, it is easier and faster to just copy the code.

If you really want to do that sort of thing by code, it would take a lot more effort. There are two ways that I know to add VBComponents. One is by SendKeys() and one is by VBComponents. For the later see, http://www.cpearson.com/excel/vbe.aspx or http://msdn.microsoft.com/en-us/library/aa443982%28VS.60%29.aspx.

[mbarron]

You can do two thing:
1) combine the 4 routines by pasting the codes into a master Sub. This could be a little harder if you use the same variable names.
2) Create a macro that call each of you Subs in succession.

Sub RunAll()
Call ImportSheetData
Call SortWorksheets
Call DeleteOldData
Call AllDataToForthSheet
End Sub

[halimi1306]

2) Create a macro that call each of you Subs in succession.

Sub RunAll()
Call ImportSheetData
Call



SortWorksheets
Call



DeleteOldData
Call AllDataToForthSheet
End Sub


Thanks mBarron, this is what I'm looking for.
My thanks also goes to Shrivallabha and Kenneth Hobs for helping me out.