Combining two macros in to one VBA code for an Active X button

[bull city bob]

I have two macros - First worksheet contains a report with several rows - one for each job site, plus a header row in row 1. The macro splits each job site in to a separate worksheet, with the header row.

The second macro then formats each worksheet - column widths, hiding columns, etc.

I have been running the first macro, then running the second macro on each sheet. I want to combine these so I can run it all with one Active x button on the first sheet. Problem is, I'm at a beginner level with visual basic, so I need some help. I've tried to combine these, but I can only get it to format the first sheet. Eventially I will have 50 or 60 job sites, so I would really like to get this to work Thanks for looking at this. Macros are below.

First macro

Sub SplitData()
Const NameCol = "A"
Const HeaderRow = 1
Const FirstRow = 2
Dim SrcSheet As Worksheet
Dim TrgSheet As Worksheet
Dim SrcRow As Long
Dim LastRow As Long
Dim TrgRow As Long
Dim Student As String
Application.ScreenUpdating = False
Set SrcSheet = ActiveSheet
LastRow = SrcSheet.Cells(SrcSheet.Rows.Count, NameCol).End(xlUp).Row
For SrcRow = FirstRow To LastRow
Student = SrcSheet.Cells(SrcRow, NameCol).Value
Set TrgSheet = Nothing
On Error Resume Next
Set TrgSheet = Worksheets(Student)
On Error GoTo 0
If TrgSheet Is Nothing Then
Set TrgSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
TrgSheet.Name = Student
SrcSheet.Rows(HeaderRow).Copy Destination:=TrgSheet.Rows(HeaderRow)
End If
TrgRow = TrgSheet.Cells(TrgSheet.Rows.Count, NameCol).End(xlUp).Row + 1
SrcSheet.Rows(SrcRow).Copy Destination:=TrgSheet.Rows(TrgRow)
Next SrcRow
Application.ScreenUpdating = True
End Sub


Second macro

Sub sbAutoAdjustColumnWidth()
Columns("A").ColumnWidth = 8.5
Columns("B").AutoFit
Columns("C:D").ColumnWidth = 8.5
Columns("H").ColumnWidth = 11.5
Columns("I").ColumnWidth = 14.75
Columns("J").ColumnWidth = 13.5
Columns("K").ColumnWidth = 16.86
Columns("L").ColumnWidth = 13.71
Range("E:G,M:S").EntireColumn.Hidden = True
Range("K1").Value = "Forms Not Started"
Range("L1").Value = "Forms Entered"
Rows(1).RowHeight = 25

End Sub

 

[dmt32]

Hi,
No need to combine second code just call it from your main code to apply format. You have already created an object variable of the worksheet in main code so all you need do is pass a copy of it to your format code – sheet(s) do not need to be active.

Try following & see if helps:

 Sub SplitData()    

    Const NameCol = "A"
    Const HeaderRow = 1
    Const FirstRow = 2
    Dim SrcSheet As Worksheet, TrgSheet As Worksheet
    Dim SrcRow As Long, LastRow As Long, TrgRow As Long
    Dim Student As String
    
    Application.ScreenUpdating = False
    
    Set SrcSheet = ActiveSheet
    LastRow = SrcSheet.Cells(SrcSheet.Rows.Count, NameCol).End(xlUp).Row
    
    For SrcRow = FirstRow To LastRow
        
        Student = SrcSheet.Cells(SrcRow, NameCol).Value
        
        On Error Resume Next
        Set TrgSheet = Worksheets(Student)
        On Error GoTo exitprog
        
        If TrgSheet Is Nothing Then
            Set TrgSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
            TrgSheet.Name = Student
            SrcSheet.Rows(HeaderRow).Copy Destination:=TrgSheet.Rows(HeaderRow)
        End If
        
    TrgRow = TrgSheet.Cells(TrgSheet.Rows.Count, NameCol).End(xlUp).Row + 1
    SrcSheet.Rows(SrcRow).Copy Destination:=TrgSheet.Rows(TrgRow)
    
    'apply format
    sbAutoAdjustColumnWidth sh:=TrgSheet
    
    Set TrgSheet = Nothing
    Next SrcRow


exitprog:
    Application.ScreenUpdating = True
If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub


Sub sbAutoAdjustColumnWidth(ByVal sh As Object)
    
    With sh
        .Columns("A").ColumnWidth = 8.5
        .Columns("B").AutoFit
        .Columns("C:D").ColumnWidth = 8.5
        .Columns("H").ColumnWidth = 11.5
        .Columns("I").ColumnWidth = 14.75
        .Columns("J").ColumnWidth = 13.5
        .Columns("K").ColumnWidth = 16.86
        .Columns("L").ColumnWidth = 13.71
        .Range("E:G,M:S").EntireColumn.Hidden = True
        .Range("K1").Value = "Forms Not Started"
        .Range("L1").Value = "Forms Entered"
        .Rows(1).RowHeight = 25
    End With


End Sub

Hope Helpful

Dave

 

[bull city bob]

Just a quick note to thank you for the help. This worked fine.

Hi,
No need to combine second code just call it from your main code to apply format. You have already created an object variable of the worksheet in main code so all you need do is pass a copy of it to your format code – sheet(s) do not need to be active.

Try following & see if helps:

 Sub SplitData()    

    Const NameCol = "A"
    Const HeaderRow = 1
    Const FirstRow = 2
    Dim SrcSheet As Worksheet, TrgSheet As Worksheet
    Dim SrcRow As Long, LastRow As Long, TrgRow As Long
    Dim Student As String
    
    Application.ScreenUpdating = False
    
    Set SrcSheet = ActiveSheet
    LastRow = SrcSheet.Cells(SrcSheet.Rows.Count, NameCol).End(xlUp).Row
    
    For SrcRow = FirstRow To LastRow
        
        Student = SrcSheet.Cells(SrcRow, NameCol).Value
        
        On Error Resume Next
        Set TrgSheet = Worksheets(Student)
        On Error GoTo exitprog
        
        If TrgSheet Is Nothing Then
            Set TrgSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
            TrgSheet.Name = Student
            SrcSheet.Rows(HeaderRow).Copy Destination:=TrgSheet.Rows(HeaderRow)
        End If
        
    TrgRow = TrgSheet.Cells(TrgSheet.Rows.Count, NameCol).End(xlUp).Row + 1
    SrcSheet.Rows(SrcRow).Copy Destination:=TrgSheet.Rows(TrgRow)
    
    'apply format
    sbAutoAdjustColumnWidth sh:=TrgSheet
    
    Set TrgSheet = Nothing
    Next SrcRow


exitprog:
    Application.ScreenUpdating = True
If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub


Sub sbAutoAdjustColumnWidth(ByVal sh As Object)
    
    With sh
        .Columns("A").ColumnWidth = 8.5
        .Columns("B").AutoFit
        .Columns("C:D").ColumnWidth = 8.5
        .Columns("H").ColumnWidth = 11.5
        .Columns("I").ColumnWidth = 14.75
        .Columns("J").ColumnWidth = 13.5
        .Columns("K").ColumnWidth = 16.86
        .Columns("L").ColumnWidth = 13.71
        .Range("E:G,M:S").EntireColumn.Hidden = True
        .Range("K1").Value = "Forms Not Started"
        .Range("L1").Value = "Forms Entered"
        .Rows(1).RowHeight = 25
    End With


End Sub

Hope Helpful

Dave