worksheet activate vba?

hi,

having trouble where i create worksheets using the below code. I want it so after the code is done to select the sheet named: "RUN".

I tried to add: Sheets(Run).Activate
 right above the MSGBOX, and doesnt seem to be doing the trick. any ideas?


Sub Tab_Clients()
Dim lr As Long, MaxRow As Long, MaxCol As Long
Dim ws As Worksheet
Dim WSThis As Worksheet
Dim vcol, I As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
Dim cCell As Range
Dim FirstAddress As String
Dim ThisYr As String, LastYr As String

'---> Disable Events
With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

vcol = 1
Set ws = Sheets("Filtered from Prev Year")
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
icol = ws.Columns.Count
LastYr = Format(Year(Now) - 1, "@")

'---> Sort Last Year Based on Client Col A
ws.UsedRange.Sort Key1:=ws.Range("A1"), order1:=xlAscending, Header:=xlYes, MatchCase:=False

Set WSThis = Sheets("Filtered from Current Year")
ThisYr = Format(Year(Now), "@")

'---> Sort This Year Based on Client Col A
WSThis.UsedRange.Sort Key1:=WSThis.Range("A1"), order1:=xlAscending, Header:=xlYes, MatchCase:=False

title = "A1:BG1"
titlerow = ws.Range(title).Cells(1).Row

ws.Cells(1, icol) = "Unique"
For I = 2 To lr
    On Error Resume Next
    If ws.Cells(I, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(I, vcol), ws.Columns(icol), 0) = 0 Then
        ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = Trim(Left(ws.Cells(I, vcol) & Space(30), 30))
    End If
Next

myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).clear
For I = 2 To UBound(myarr)
    ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(I) & "*"
    If Not Evaluate("=ISREF('" & myarr(I) & "'!A1)") Then
        Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(I) & ""
    Else
        Sheets(myarr(I) & "").Move after:=Worksheets(Worksheets.Count)
    End If
    If Sheets(myarr(I) & "").Range("A1") <> "Year" Then
        ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(I) & "").Range("A1")
        Sheets(myarr(I) & "").Range("A1").EntireColumn.Insert
        Sheets(myarr(I) & "").Range("A1") = "Year"
        Sheets(myarr(I) & "").Range("A1").Offset(1, 0) = LastYr
    Else
        ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(I) & "").Range("A1")
        Sheets(myarr(I) & "").Range("A1").Offset(1, 0).Insert xlShiftToRight
        Sheets(myarr(I) & "").Range("A1").Offset(1, 0) = LastYr
    End If
    MaxRow = Sheets(myarr(I) & "").Range("A" & Sheets(myarr(I) & "").Rows.Count).End(xlUp).Row + 1
    
    '---> Get Data from Last Year
    With WSThis.UsedRange
        Set cCell = .Find(What:=myarr(I), LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)
        If Not cCell Is Nothing Then
            FirstAddress = cCell.Address
            Do
                cCell.EntireRow.Copy Sheets(myarr(I) & "").Range("A" & MaxRow)
                Sheets(myarr(I) & "").Range("A" & MaxRow).Insert xlShiftToRight
                Sheets(myarr(I) & "").Range("A" & MaxRow) = ThisYr
                MaxRow = MaxRow + 1
                Set cCell = .FindNext(cCell)
            Loop While Not cCell Is Nothing And cCell.Address <> FirstAddress
        End If
    End With
    
    '---> Columns Autofit
    Sheets(myarr(I) & "").Columns.AutoFit

    CHARTCLIENT2
Next

'---> Loop thru all clients and add tab for those not existing
lr = WSThis.Cells(WSThis.Rows.Count, vcol).End(xlUp).Row
For I = 2 To lr
    On Error Resume Next
    If WSThis.Cells(I, vcol) <> "" And Application.WorksheetFunction.Match(WSThis.Cells(I, vcol), ws.Columns(icol), 0) = 0 Then
        WSThis.Cells(WSThis.Rows.Count, icol).End(xlUp).Offset(1) = Trim(Left(WSThis.Cells(I, vcol) & Space(30), 30))
    End If
Next

myarr = Application.WorksheetFunction.Transpose(WSThis.Columns(icol).SpecialCells(xlCellTypeConstants))
WSThis.Columns(icol).clear

For I = 2 To UBound(myarr)
    WSThis.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(I) & "*"
    If Not Evaluate("=ISREF('" & myarr(I) & "'!A1)") Then
        Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(I) & ""
    
        '---> Get Data only for the sheets that have This year and not last year
        If Sheets(myarr(I) & "").Range("A1") <> "Year" Then
            WSThis.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(I) & "").Range("A1")
            Sheets(myarr(I) & "").Range("A1").EntireColumn.Insert
            Sheets(myarr(I) & "").Range("A1") = "Year"
            Sheets(myarr(I) & "").Range("A1").Offset(1, 0) = ThisYr
        Else
            ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(I) & "").Range("A1")
            Sheets(myarr(I) & "").Range("A1").Offset(1, 0).Insert xlShiftToRight
            Sheets(myarr(I) & "").Range("A1").Offset(1, 0) = ThisYr
        End If
    End If

    '---> Columns Autofit
    Sheets(myarr(I) & "").Columns.AutoFit

Next I

WSThis.AutoFilterMode = False
ws.AutoFilterMode = False
ws.Activate

'---> Sort Worksbook
Sort_Active_Book

'---> Enable Events
With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .DisplayAlerts = False
End With



MsgBox "Creation of Clients tab done.", vbExclamation
End Sub

Open in new window

jfrank85Asked:
Who is Participating?
 
Martin LissOlder than dirtCommented:
Sheets("Run").Activate
0
 
gowflowCommented:
Is Run a new sheet ? if yes and this one you want to get the focus once the whole macro has run then yes Martin's answer is the correct one.

However if you want the routine to simply get focus right where it first started then simply move this line
ws.Activate

from where it is to just after this line this way:
'---> Sort Worksbook
Sort_Active_Book
ws.Activate

This way once the sort workbook is finish the focus goes back to WS which is the Previous year. If you want the focus on this year then put it like this:
'---> Sort Worksbook
Sort_Active_Book
wsThis.Activate

gowflow
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.