Vba Macro To Name Sheets Based On Lookup Results

Worksheets("RawData").Select 
Call LoadTicker(Range("AA1", "AA100" ), -3) 
 
Sub LoadTicker(rRange As Range, iOffset As Integer) 
    Worksheets("CFG").Select 
    Dim varCell As Range 
    For Each varCell In rRange.Cells 
        varCell.Select 
        Dim b As Variant 
        b = Application.WorksheetFunction.VLookup(varCell.Offset(0, iOffset ).Value, Range("A10", "B14"), 2, False) 
        varCell.value=b 
         ' varCell.FormulaR1C1 = "=VLOOKUP(RC[-2],rr,2,FALSE)"
         
    Next varCell 
End Sub 

Sub select_data() 
    Dim mysting As String 
    Dim foundcell As range 
    Dim range1 As range 
    Dim cell1 As range 
    Dim counter As Integer 
    counter = 3 
    mystring = InputBox("enter what to be found") 
    Sheets("data").Activate 
    Set range1 = ActiveSheet.range("a1:h31") 
     
    With range1 
        Set foundcell = range1.Find(What:=mystring, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) 
        If Not foundcell Is Nothing Then 
            firstadress = foundcell.Address 
            Do 
                Set cell1 = foundcell 
                cell1.Copy 
                Sheets("select data").Activate 
                Cells(counter, 2).Select 
                ActiveSheet.Paste 
                counter = counter + 1 
                Set foundcell = .FindNext(foundcell) 
            Loop While Not foundcell Is Nothing And foundcell.Address <> firstaddress 
        End If 
    End With 
End Sub 

Dim MyMonth As Variant 
MyMonth = Application.InputBox(Prompt:="Please select current month.") 
Sheets("& MyMonth & TOTAL").Select 
If ActiveSheet.FilterMode Then 
    ActiveSheet.ShowAllData 

Sub encode1()

Dim Counter As Integer
Dim MyString As String
Dim NewString As String
Dim NextChar As String
Dim Key As Integer

MyString = Cells(1, 1)
Key = inputbox("Enter Key")

For Counter = 1 To Len(MyString)

range1 = Mid(MyString, Counter, 1)

NextChar = Application.VLookup(Range(range1), Range("y1:z95"), 2, 0)

NewString = NewString & NextChar

Next


'convert newstring to number?
'NewString = NewString * Key
Cells(3, 1) = NewString

End Sub

Sub Get_Pending_Accurals()
'
' Get_Pending_Accurals Macro
'

    Sheets("Sheet2").Select
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:= _
        "EK"
     ActiveSheet.ListObjects("Table1").Range.AdvanceFilter Field:=17, _
        Action = xlFilterInPlace_
        CriteriaRange = Range("<>0") 
'Paste to new sheet
    Sheets("Sheet2").Select
    Range("D1:D988").Select
    Selection.Copy
    Sheets("Sheet1").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("Sheet2").Select
    Range("C1:C988").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    Range("B1").Select
    ActiveSheet.Paste
    Sheets("Sheet2").Select
    Range("H1:H988").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    Range("C1").Select
    ActiveSheet.Paste
    Sheets("Sheet2").Select
    Range("I1:I988").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    Range("D1").Select
    ActiveSheet.Paste
    Sheets("Sheet2").Select
    ActiveWindow.SmallScroll ToRight:=10
    Range("Q1:Q988").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    Range("E1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E9").Select
End Sub

Sub AssignJobDescription()

Dim res As Variant
Dim LookUpRng As Range
Dim myVal As Variant
Dim myLookUpVal As Variant

FinalRow = Cells(65536, 1).End(xlUp).Row
For i = 2 To FinalRow

myVal = ActiveSheet.Range("B2")

If myVal = 9000000 Then
Set LookUpRng = Worksheets("Info").Range("g2:H60")
myLookUpVal = ActiveSheet.Range("c2").Value
Else
Set LookUpRng = Worksheets("Info").Range("j2:k60")
myLookUpVal = ActiveSheet.Range("b2").Value
End If

res = Application.VLookup(myLookUpVal, LookUpRng, 2, False)

If IsError(res) Then
res = "Not Found!"
End If

ActiveSheet.Cells(h, i).Value = res

Next i
End Sub

Option Explicit

Dim sName As String
Dim sPic As String

sPic = Application.InputBox("Enter the Sheet To be Copied:", Title:="Source Sheet Title", Type:=2)
    If sPic = "" Then Exit Sub

Dim v: v = Evaluate("ISREF(sPic!A1)")

If v Then
    sName = Application.InputBox("Enter the new sheet name:", Title:="New Sheet Title", Type:=2)
    If sName = "" Then Exit Sub
    Sheets("sPic").Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = sName
Else
    MsgBox "The ""sPic"" cannot be found."
End If

End Sub

Option Explicit
Sub NewSheetFromTemplate()
    Dim sName As String
    
    sName = Application.InputBox("Enter the new sheet name:", Title:="New Sheet Title", Type:=2)
    If sName = "" Then Exit Sub
    
    ActiveWorkbook.Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = sName
    
    Sheets("Template").Cells.Copy
    With Sheets(sName).Range("A1")
        .PasteSpecial xlValues
        .PasteSpecial xlFormats
        .PasteSpecial xlPasteValidation
    End With

End Sub

'
' Macro4444 Macro
' Macro recorded 12/05/2009
'
' Keyboard Shortcut: Ctrl+d
'
    Sheets("Sheet 3").Select
    Range("F2").Select
    Selection.Copy
    Sheets("Side One").Select
    ActiveSheet.Paste
    Range("G42").Select
    Sheets("Sheet 3").Select
    Range("E2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Side One").Select
    ActiveSheet.Paste
    Range("D48").Select
    Sheets("Sheet 3").Select
    Range("A2:D2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Side One").Select
    ActiveSheet.Paste
    Range("I48").Select
    Sheets("Sheet 3").Select
    Range("G2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Side One").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Sheets("Sheet 3").Select
    Range("A3").Select
End Sub

Sub ViewContacts() '
     ' ViewContacts Macro
     '
     
     
     '
    Sheets("Contacts").Select 
End Sub 
Sub AddContact() 
     '
     ' AddContact Macro
     '
     
     
     '
    Range("E8").Select 
    Selection.Copy 
    Sheets("Contacts").Select 
    Range("C10").Select 
    ActiveSheet.Paste 
    Sheets("Sheet3").Select 
    Range("E9").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Contacts").Select 
    Range("D10").Select 
    ActiveSheet.Paste 
    Sheets("Sheet3").Select 
    Range("E10").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Contacts").Select 
    Range("E10").Select 
    ActiveSheet.Paste 
    Sheets("Sheet3").Select 
    Range("E11").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Contacts").Select 
    Range("F10").Select 
    ActiveSheet.Paste 
    Sheets("Sheet3").Select 
    Range("E12").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Contacts").Select 
    Range("G10").Select 
    ActiveSheet.Paste 
End Sub 

    Dim myString As String
    Dim foundCell As Variant
    
    myString = Trim(UserForm2.TextBox1.Value)
    If myString = vbNullString Then
        Exit Sub
    End If
    
    On Error GoTo ErrorOut
        With ThisWorkbook.Sheets("Sheet1").Range("A:A")
            .Find(what:=myString, After:=.Cells(1, 1), lookat:=xlWhole).Delete shift:=xlUp
        End With
    
        With ThisWorkbook.Sheets("Sheet2")
            .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = myString
        End With

Public Sub texttonewsheet() 
    Dim n As Long, i As Long 
    Dim Rng As range 
    With Application 
        .Calculation = xlCalculationManual 
        .ScreenUpdating = False 
    End With 
    n = 1 
    For i = 2 To Sheets.Count 
        For Each Rng In Sheets(i).range("A1:CI200") 
            If Rng.Value <> "" Then 
                If Not Application.IsNumber(Rng) Then 
                    Sheets(1).range("A" & n).Value = Rng.Value 
                    Sheets(1).range("B" & n).Value = Rng.Address 
                    Sheets(1).range("C" & n).Value = Sheets(i).Name 
                    n = n + 1 
                End If 
            End If 
        Next Rng 
    Next i 
    With Application 
        .Calculation = xlCalculationAutomatic 
        .ScreenUpdating = True 
    End With 
End Sub 

Sub hideitems() 
    Dim pt As PivotTable 
    Dim pi As PivotItem 
    Dim ws As Worksheet 
    Dim MyItem As Variant 
    Dim MyString As String 
    Application.EnableCancelKey = xlDisabled 
    MyItem = Application.InputBox("Enter Pivot Item to hide.") 
    MyString = MyItem 
    If MyItem = "" Then Exit Sub 
    If MyMonth = "False" Then Exit Sub 
    On Error Resume Next 
    Application.ScreenUpdating = False 
    For Each ws In ActiveWorkbook.Worksheets 
        For Each pt In ws.PivotTables 
            If pt.PivotFields("Chg Procedure Code").PivotItems(MyItem).Visible = True Then 
                pt.ManualUpdate = True 
                pt.PivotFields("Chg Procedure Code").AutoSort xlManual 
                pt.PivotFields("Chg Procedure Code").PivotItems(MyItem).Visible = False 
                pt.ManualUpdate = False 
                pt.PivotFields("Chg Procedure Code").AutoSort xlAscending 
                 
            End If 
        Next pt 
    Next ws 
    Application.ScreenUpdating = True 
     
End Sub 

Dim MyVar As String 
MyVar = Application.VLookup(Range("F9"), Range("V7:W87"), 2, False) 
Sheets("Input").Range("G9").Value = MyVar 
Sheets("Input").Select 
If Sheets("Input").Range("G9") = CVErr(xlErrNA) Then 
    Sheets("Input").Range("V6").Select 
    MsgBox "Enter the KMAT and KMAT Description in the Table", vbCritical, "Missing Data" 
    Exit Sub 
End If