[VBA] - Need to Hide one column and need sum of columns

[rsolanki]

Hello All,

Finally I have been able to create a Master Sub which includes multiple Macro. Everything is working fine just need few changes. Please see the Excel Sheet below and whole VBA Code

Sub DoctorShare_Automation()

    InsertColumn
    ConcatenateColumns
    VlookupDoctorShare
    DoctorAmountCalculation
    SplitNames_newWB

End Sub

Private Sub InsertColumn()

Sheet1.Range("E:E").EntireColumn.Insert Shift:=xlToRight
Sheet1.Range("I:I").EntireColumn.Insert Shift:=xlToRight
With Rows(1)
    .Replace What:="Column1", Replacement:="LookupValue", LookAt:=xlWhole
    .Replace What:="Column2", Replacement:="DoctorPer", LookAt:=xlWhole
  End With

End Sub
Private Sub ConcatenateColumns()

 Sheet1.Range("E2").Select
 ActiveCell.FormulaR1C1 = _
        "=CONCATENATE([@[Service Doctor]],""/"",[@[Case_Type]],""/"",[@Department])"
    Range("E3").Select

End Sub

Private Sub VlookupDoctorShare()
'
' VlookupDoctorShare Macro
'
 Sheet1.Range("I2").Select
 ActiveCell.FormulaR1C1 = "=VLOOKUP([@[LookupValue]],Sheet2!C[-8]:C[-7],2,FALSE)"
    Range("I3").Select
End Sub
Private Sub DoctorAmountCalculation()
'
' DoctorAmountCalculation Macro
'
Sheet1.Range("H2").Select
    ActiveCell.FormulaR1C1 = "=([@[Service Amt]]*[@[DoctorPer]])/100"
    Range("H3").Select
End Sub

Private Sub SplitNames_newWB()

Const N As Integer = 1 '<< headings in rows 1-2

Const sCol$ = "A" '<<< export data from column A

Const srcName$ = "Sheet1" '<<< Source Sheet Name

Dim c As New Collection, cItem

Dim wb1 As Workbook, wb2 As Workbook

Dim ws As Worksheet, ws1 As Worksheet

Dim sPath As String, strDate As String

Dim r As Long, i As Long, j As Long

Dim cc As Variant

Set wb1 = ThisWorkbook

Set ws = wb1.Sheets(srcName)

sPath = ThisWorkbook.Path

Application.ScreenUpdating = False

ws.AutoFilterMode = False

r = ws.Cells(Rows.Count, 1).End(xlUp).Row

On Error Resume Next

For Each cItem In ws.Range(sCol & N + 1 & ":" & sCol & r)

c.Add cItem, cItem

Next

On Error GoTo 0

Set wb2 = Workbooks.Add(1)

For Each cc In c

ws.Range(ws.Cells(N, sCol), ws.Cells(r, sCol)).AutoFilter Field:=1, Criteria1:=cc

Set ws1 = wb2.Worksheets.Add(After:=wb2.Worksheets(wb2.Worksheets.Count))

ws1.Name = cc

ws.Rows("1:" & r).SpecialCells(xlCellTypeVisible).Copy

With ws1.Range("A1")

.PasteSpecial Paste:=xlPasteFormats

.PasteSpecial Paste:=xlPasteValues

End With

Application.CutCopyMode = False

ActiveSheet.UsedRange.EntireColumn.AutoFit

Next cc

ws.AutoFilterMode = False

Application.DisplayAlerts = False

wb2.Sheets(1).Delete

strDate = Format(Now, "yyyymmdd_hhmm")

wb2.SaveAs sPath & "\" & strDate & ".xlsx"

Application.DisplayAlerts = True

For i = 1 To wb2.Sheets.Count - 1

For j = i + 1 To wb2.Sheets.Count

If UCase(wb2.Sheets(j).Name) < UCase(wb2.Sheets(i).Name) Then

wb2.Sheets(j).Move before:=wb2.Sheets(i)

End If

Next j

Next i

wb2.Sheets(1).Select

wb2.Save

wb2.Close False

Application.ScreenUpdating = True

MsgBox "new wb" & vbCr & strDate & ".xlsx" & vbCr & "is ready in this wb path"

End Sub

1. I would like to add VBA Code in Sub Splitnames_newWB () which can hide Column E from all Sheet that this Sub creates
2. I would like Sum of Column G and Column H at the end after 2 rows once content complete. Specially in Bold
3. Currently Sub Splitnames_newWB () is creating separate workbook and all sheets are created in this new workbook, This is fine but just wanted to know Is it possible to add sheets in same workbook instead of creating different WB.
4. Any Sub to export sheets in PDF in Landscape? with all columns fitting print page.

Look forward to your suggestions

Thanks in Advance