Combining 2 Subs into one

Carlit007

New Member
Joined
Sep 5, 2018
Messages
35
Office Version
  1. 2019
  2. 2016
  3. 2013
Platform
  1. Windows
  2. MacOS
Hi I have the following 2 subs which I have been able to make work independently but would like to figure out how to combine into one task.
If anybody could help this Novice it would be greatly apreciated

SUB #1 (ImportData) which is the work in progress its Purpose is to give user an open file option to import data into current workbook which is a template
1.) user clicks on a button
2.) user gets a file prompt to choose the file & Open workbook to import data from another workbook generated from a system report
3.) Sub #2 Below is supposed to happen to the newly open file
4.) Data From Open file is supposed to be Pasted into template workbook WB in worksheet "Unit Roster" cell Range B2

SUB #2 (MergeShData) does the following: to a worksheet which is a workbook that is generated from a report
1.)It clears whatever data is in sheet1 and renames it to "master"
2. )it looks at all worksheets (Except "Master") in workbook and copies the data from region starting B2 to the "Master" worksheet
3.)It them sorts the data




Here is the Code For SUB# 1 Called ImportData note this one is work in progress
VBA Code:
Sub [B]ImportData[/B]()  '[COLOR=rgb(97, 189, 109)] this is my attempt to copy data after SUB# was done independently [/COLOR]

Dim FileToOpen As Variant
Dim OpenBook As Workbook

Application.ScreenUpdating = False

FileToOpen = Application.GetOpenFilename(title:="Browse for your file & import range", FileFilter:="excel files(*.xls*),*xls*")

If FileToOpen <> False Then

Set OpenBook = Application.Workbooks.Open(FileToOpen)
OpenBook.Worksheets("Master").Range("B2").Copy
'CurrentRegion.Sort key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo
ThisWorkbook.Worksheets("Sheet1").Range("B2").Paste
OpenBook.Close False

End If

Application.ScreenUpdating = True

End Sub

And this is the VBA Code for SUB#2 (MergeShData) I got it to do mostly everything I want it to do

VBA Code:
Sub [B]MergeShData[/B]() 'use this to combine and export to template

Application.ScreenUpdating = False

Dim Sht As Worksheet
'Range("A1", [B4].SpecialCells(xlLastCell)).ClearContents
Cells.Select
'Range("J14").Activate
Selection.ClearContents
Selection.Delete Shift:=xlUp
Sheets("Sheet1").Name = "Master"
    'Range("A1").Select

For Each Sht In ActiveWorkbook.Worksheets

Sht.Activate
If Sht.Name <> "Master" And Sht.Range("B4").Value <> "" Then
Lastrow = Range("B65536").End(xlUp).Row
Columns("C:C").Delete Shift:=xlToLeft 'delete if not working
Range("B4", Cells(Lastrow, "M")).Copy

Sheets("Master").Select
Range("B65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
'Columns("C:C").Delete 'Shift:=xlToLeft
End If
Next Sht


Application.CutCopyMode = False
Sheets("Master").Range("B2").CurrentRegion.Sort key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo

'use this code to make sure the colums autofit
ActiveSheet.Cells.WrapText = False
ActiveSheet.Cells.EntireColumn.AutoFit
'Range("A1").Select
'Columns("B:B").Delete Shift:=xlToLeft
'Selection.Delete Shift:=xlToLeft

Application.ScreenUpdating = True

End Sub

What I want to do is basically

1. run the VBA code in SUB#1 to initiate file open and choosing the file to get data from
2. Sub#2 carries out its function listed above without saving the changes to the chosen file.
3. Data from the newly open workbook # 2, Worksheet "Master" is copied to template workbook containing a worksheet named "Unit Roster" Range (B2)
 

Some videos you may like

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
Instead of merging the two codes, I just called the second macro to run immediately after the workbook is opened in the first procedure. The workbook is passed to the second macor as an object. Give it a try and post back if there is a problem.

VBA Code:
Sub ImportData()
Dim FileToOpen As String
Dim OpenBook As Workbook
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Browse for your file & import range", FileFilter:="excel files(*.xls*),*xls*")
    If FileToOpen <> "" Then
         Set OpenBook = Application.Workbooks.Open(FileToOpen)
         MergeShData OpenBook
         OpenBook.Worksheets("Master").Range("B2").Copy
         'CurrentRegion.Sort key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo
         ThisWorkbook.Worksheets("Sheet1").Range("B2").Paste
         OpenBook.Close False
    End If
Application.ScreenUpdating = True
End Sub

Sub MergeShData(wb As Workbook)
Application.ScreenUpdating = False
Dim Sht As Worksheet
On Error Resume Next
     If wb.Sheets("Master") Is Nothing Then
         Sheets(1).Name = "Master"
     End If
On Error GoTo 0
Err.Clear
wb.Sheets("Master").UsedRange.Clear
     For Each Sht In wb.Worksheets
          If Sht.Name <> "Master" And Sht.Range("B4").Value <> "" Then
              With Sht
                   LastRow = .Cells(Rows.Count, 2).End(xlUp).Row
                  .Columns("C:C").Delete Shift:=xlToLeft 'delete if not working
                  .Range("B4", Cells(LastRow, "M")).Copy wb.Sheets("Master").Cells(Rows.Count, 1).End(xlUp)(2)
              End With
         End If
    Next Sht
    With wb.Sheets("Master")
          .Range("B2").CurrentRegion.Sort key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo
         'use this code to make sure the colums autofit
        .Cells.WrapText = False
       .Cells.EntireColumn.AutoFit
    End With
Application.ScreenUpdating = True
End Sub
 
Last edited:

Carlit007

New Member
Joined
Sep 5, 2018
Messages
35
Office Version
  1. 2019
  2. 2016
  3. 2013
Platform
  1. Windows
  2. MacOS
Instead of merging the two codes, I just called the second macro to run immediately after the workbook is opened in the first procedure. The workbook is passed to the second macor as an object. Give it a try and post back if there is a problem.

VBA Code:
Sub ImportData()
Dim FileToOpen As String
Dim OpenBook As Workbook
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Browse for your file & import range", FileFilter:="excel files(*.xls*),*xls*")
    If FileToOpen <> "" Then
         Set OpenBook = Application.Workbooks.Open(FileToOpen)
         MergeShData OpenBook
         OpenBook.Worksheets("Master").Range("B2").Copy
         'CurrentRegion.Sort key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo
         ThisWorkbook.Worksheets("Sheet1").Range("B2").Paste
         OpenBook.Close False
    End If
Application.ScreenUpdating = True
End Sub
[COLOR=rgb(184, 49, 47)]
Sub MergeShData(wb As Workbook)    '<-----///// I Get a "Compile error, Variable not define" message when running the code //////
Application.ScreenUpdating = False
Dim Sht As Worksheet
On Error Resume Next
     If wb.Sheets("Master") Is Nothing Then
         Sheets(1).Name = "Master"
     End If
On Error GoTo 0
Err.Clear
wb.Sheets("Master").UsedRange.Clear
     For Each Sht In wb.Worksheets
          If Sht.Name <> "Master" And Sht.Range("B4").Value <> "" Then
              With Sht
                   LastRow = .Cells(Rows.Count, 2).End(xlUp).Row
                  .Columns("C:C").Delete Shift:=xlToLeft 'delete if not working
                  .Range("B4", Cells(LastRow, "M")).Copy wb.Sheets("Master").Cells(Rows.Count, 1).End(xlUp)(2)
              End With
         End If
    Next Sht
    With wb.Sheets("Master")
          .Range("B2").CurrentRegion.Sort key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo
         'use this code to make sure the colums autofit
        .Cells.WrapText = False
       .Cells.EntireColumn.AutoFit
    End With
Application.ScreenUpdating = True
End Sub

I got an error on the area in my comment above
 
Last edited:

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
I got an error on the area in my comment above
1. What was the error message ?
2. Which comment above?

Some VBA code will error on a MAC because of the OS differences.

Remember, we cannot see your worksheet. You must either give complete written descriptions of issues or post links and/or images to display the data you refer to. Help us help you.
 

Carlit007

New Member
Joined
Sep 5, 2018
Messages
35
Office Version
  1. 2019
  2. 2016
  3. 2013
Platform
  1. Windows
  2. MacOS
at first I got an error on the following line

VBA Code:
Sub MergeShData(wb As Workbook)

but somehow I fixed it

Now I am getting a variable not define for the following line

VBA Code:
LastRow = .Cells(Rows.Count, 2).End(xlUp).Row
 

Carlit007

New Member
Joined
Sep 5, 2018
Messages
35
Office Version
  1. 2019
  2. 2016
  3. 2013
Platform
  1. Windows
  2. MacOS
Updates so after many countless hours of research and using everything I have learned in this wonderful Forum I was able to somewhat combine the 2 Sub procedures
into one. below is what I came up with

VBA Code:
Option Explicit

Sub RCASfileImportV8()  'Use this data to automatically Import data from RCAS DMOS Roster


Dim SourceWorkbook As Variant
Dim CurrentWorkbook As Workbook
Dim Sht As Worksheet
Dim Lastrow As Long

Application.ScreenUpdating = False
SourceWorkbook = Application.GetOpenFilename(Title:="Browse for your file & import range", FileFilter:="excel files(*.xls*),*xls*")
Set CurrentWorkbook = ThisWorkbook  'this creates a open file dialog for user to choose the file to import


If SourceWorkbook <> False Then
Set SourceWorkbook = Application.Workbooks.Open(SourceWorkbook)

For Each Sht In SourceWorkbook.Sheets ' this loop copies information from each worksheet in the source file to the destination

Sht.Activate
If Sht.Name <> "Sheet1" Then 'this excludes "Sheet1" which is just the Report Sumary cover page
Lastrow = Range("B65536").End(xlUp).Row
Columns("C:C").Delete Shift:=xlToLeft 'this deletes colum C of each sheet in report to match the destination file
Range("B4", Cells(Lastrow, "I")).Copy

CurrentWorkbook.Activate    'this activate the current workbook with the template
CurrentWorkbook.Sheets("Unit Roster").Select
Range("B65536").End(xlUp).Offset(1, 0).Select
CurrentWorkbook.Sheets("Unit Roster").Range("B2").PasteSpecial xlPasteValues


End If
    Next Sht

SourceWorkbook.Close False

End If

Application.ScreenUpdating = False

End Sub

this has gotten me to around 90% to where I want to be I'm just now having 2 issues

Issue# 1.
For some reason out of 68 records only 50 are being imported into the destination sheet "Unit Roster"
to give you an idea here's the break down for number of user data per sheet in the source file

Sheet1 hold no valuable data and that why its excluded
Sheet2 holds 1 record
Sheet3 holds 50 records
Sheet4 Holds 17 records

the information that does import is completely a mix of the 3 worksheets above

Issue # 2.

I keep getting the following clipboard error message at the very end of the Import


clipboard error.JPG


Please let me know If I missed anything I'm completely a noob who just got lucky with making the code work this far
 

Watch MrExcel Video

Forum statistics

Threads
1,127,556
Messages
5,625,496
Members
416,112
Latest member
somenka

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
Top