Email:      Pass:    Pass?
Close Window   
TE
Subscribe for Email Updates!
Excel tips, help, and more!
E-mail:


Advertisements


Free Excel Forum

Vba Macro To Name Sheets Based On Lookup Results

Forum Register
Search Excel Forum Posts, Tutorials, Macros, Tips, and More

I want to name three sheets (sheets will have a different name every month so I refer to them below as Sheet(1), Sheet(2), and Sheet(3) (Their sheet index)) using a vlookup in VBA. I want the code to promt the user for input and based on the entry, I want to use a vlookup to name the sheets. There are three "lookup tables" on a sheet named "Ref" that I have defined as Table1 (used for naming Sheet(1)), Table2 (used for naming Sheet(2)), and Table3 (used for naming Sheet(3)) that I want to reference in the code.
I also want a code to check the first MyLookUp1 which I have attemped below, but I do not know if I am doing this correctly.

Below is my bad VBA attempt so you get an idea of what I am trying to do. Also, attached is an exaple file.

VB:

Sub namesheets() 
    Dim MyEntry As Variant 
    Dim MyLookUp1 As Variant 
    Dim MyLookup2 As Variant 
    Dim MyLookup3 As Variant 
    Dim MySTRING As String 
    MyEntry = Application.InputBox( _ 
    Prompt:="Please enter an Item:", _ 
    Title:="Lookup sheet name", _ 
    Type:=2) 
    MySTRING = MyEntry 
     
    MyLookUp1 = Application.VLookup(MySTRING, Table1, 2, False) 
    If IsError(MyLookUp1) Then Exit Sub 
     
    Sheets(1).Select 
    ActiveSheet.Name = MyLookUp1 
     
    MyLookup2 = Application.VLookup(MySTRING, Table2, 2, False) 
    Sheets(2).Select 
    ActiveSheet.Name = MyLookup2 
     
    MyLookup3 = Application.VLookup(MySTRING, Table3, 2, False) 
    Sheets(3).Select 
    ActiveSheet.Name = MyLookup3 
     
End Sub 


If you like these VB formatting tags please consider sponsoring me in support of injured Royal Marines




Similar Excel Video Tutorials

Helpful Excel Macros

Name Worksheets Based on Cell Contents
- This macro allows you to have your worksheets named by whatever is in a particular cell within a worksheet. This means
Delete All Chart Sheets in Excel - Only Chart Sheets are Deleted - Not Embedded Charts
- Delete all chart sheets and tabs in Excel using this macro. This will only delete the charts and graphs that are in the
Vlookup Function That Searches The Entire Workbook - UDF
- This UDF is a Vlookup function that searches the entire workbook in Excel. The syntax and usage of the function is exac
Delete Entire Rows Based on Predefined Criteria (Text)
- This macro will allow you to specify certain criteria and then to delete rows based upon that criteria. You will choose
Combine Multiple Workbooks into One
- This macro for Microsoft Excel allows you to combine multiple workbooks and worksheets into one new workbook and workshe

Similar Topics







I've got a worksheet with several tables, each of which I've assigned a defined name. At the top of my worksheet I have several cells containing lookup functions, and these are repeated for each defined table on the sheet.

Right now I'm creating all my lookup functions for a single table, copying the cells containing these functions, and editing the references to the defined names in the copies by hand, giving me a final product something like this:

Code:

                      A                       B                      C                      D
1
2                    10                      10                     10                     10
3 =VLOOKUP(A$2,Table1,2) =VLOOKUP(B$2,Table2,2) =VLOOKUP(C$2,Table3,2) =VLOOKUP(D$2,Table4,2)
4 =VLOOKUP(A$2,Table1,3) =VLOOKUP(B$2,Table2,3) =VLOOKUP(C$2,Table3,3) =VLOOKUP(D$2,Table4,3)
5 =VLOOKUP(A$2,Table1,4) =VLOOKUP(B$2,Table2,4) =VLOOKUP(C$2,Table3,4) =VLOOKUP(D$2,Table4,4)
6 =VLOOKUP(A$2,Table1,5) =VLOOKUP(B$2,Table2,5) =VLOOKUP(C$2,Table3,5) =VLOOKUP(D$2,Table4,5)


To get this result, I'd normally do all the formulas in Column A first, then copy these formulas to Columns B-D, but doing that gives me the result below:
Code:

                      A                       B                      C                      D
                      A                       B                      C                      D
1
2                    10                      10                     10                     10
3 =VLOOKUP(A$2,Table1,2) =VLOOKUP(B$2,Table1,2) =VLOOKUP(C$2,Table1,2) =VLOOKUP(D$2,Table1,2)
4 =VLOOKUP(A$2,Table1,3) =VLOOKUP(B$2,Table1,3) =VLOOKUP(C$2,Table1,3) =VLOOKUP(D$2,Table1,3)
5 =VLOOKUP(A$2,Table1,4) =VLOOKUP(B$2,Table1,4) =VLOOKUP(C$2,Table1,4) =VLOOKUP(D$2,Table1,4)
6 =VLOOKUP(A$2,Table1,5) =VLOOKUP(B$2,Table1,5) =VLOOKUP(C$2,Table1,5) =VLOOKUP(D$2,Table1,5)


As you can see, I still have to go in to Columns B-D and manually correct the table reference names. So, my question is this: is it possible to enter the text values Table1, Table2, etc. in Row 1, and somehow have all my vlookup functions extract the name of the table to use from these cells? I know I can't just do something like having the formula in A3 =VLOOKUP(A$2,A$1,2) since that will make the formula think that the range A1 itself is where I want to do the lookup. Any ideas?


Hello there!

I need to select all sheets except the first using VBA, but I am having trouble with the code that I wrote. It is currently selecting the second and last sheet and I cannot figure out why!

Any help would be much appreciated!

Code:

Option Explicit

Sub ClearAll()
'
'   Coded by Dave on 7/8/10

Dim ws As Worksheet
Dim Msg, Style, Title, Help, Ctxt, Response, MyString

    Msg = "Are you sure? All data will be permanently erased!"
    Style = vbYesNo + vbCritical + vbDefaultButton2
    Title = "Erase figures?"
    Response = MsgBox(Msg, Style, Title, Help, Ctxt)
    If Response = vbYes Then
    MyString = "Yes"
    Else
    If Response = vbNo Then End
    MyString = "No"
    End If

    Msg = "Are you really sure you want to do this?"
    Style = vbOKCancel + vbExclamation + vbDefaultButton2
    Title = "Erase figures?"
    Response = MsgBox(Msg, Style, Title, Help, Ctxt)
    If Response = vbOK Then
    MyString = "OK"
    Else
    If Response = vbCancel Then End
    End If

  Application.ScreenUpdating = False

    Sheets(2).Select
        For Each ws In ActiveWorkbook.Sheets
        ws.Unprotect

            If ws.Index <> 1 Then ws.Select False
        Next ws
                Range("B11:B402,D11:D402,F11:F402,H11:H402,J11:J402,L11:L402,N11:N402").Select
                    Selection.ClearContents
    
  Sheets(1).Select
    For Each ws In ActiveWorkbook.Sheets
        ws.Protect
    Next ws
    
 
    
  Application.ScreenUpdating = True
  
End Sub





Hey Guys I Have I Q

I'd Like To Make To Make Every Thing Variable In "Gray Table" So I Can Choose According To My Need I Work

Ex
1- Ranges Variables So I Can Choose The Range I Need
2- Look Up Table Variable So I Can Choose Between Tables I need
3- Color Every Range With Specific Color Through Drop Down List Color

Sheet1

  A B C D E F G H I J K L M N O P Q 1 A1 C 700     Range Tables Color   Table1   Table2   Table3 2 A2 C 701   First LookUp A1 A4 Table1 Blue Sky   A1 C 700   A1 Z 500   A1 Y 300 3 A3 C 702   Second LookUp A5 A13 Table3 Red   A2 C 701   A2 Z 501   A2 Y 301 4 A4 C 703   Third LookUp A14 A18 Table2 Yellow   A3 C 702   A3 Z 502   A3 Y 302 5 A5 Y 304               A4 C 703   A4 Z 503   A4 Y 303 6 A6 Y 305               A5 C 704   A5 Z 504   A5 Y 304 7 A7 Y 306               A6 C 705   A6 Z 505   A6 Y 305 8 A8 Y 307               A7 C 706   A7 Z 506   A7 Y 306 9 A9 Y 308               A8 C 707   A8 Z 507   A8 Y 307 10 A10 Y 309               A9 C 708   A9 Z 508   A9 Y 308 11 A11 Y 310               A10 C 709   A10 Z 509   A10 Y 309 12 A12 Y 311               A11 C 710   A11 Z 510   A11 Y 310 13 A13 Y 312               A12 C 711   A12 Z 511   A12 Y 311 14 A14 Z 513               A13 C 712   A13 Z 512   A13 Y 312 15 A15 Z 514               A14 C 713   A14 Z 513   A14 Y 313 16 A16 Z 515               A15 C 714   A15 Z 514   A15 Y 314 17 A17 Z 516               A16 C 715   A16 Z 515   A16 Y 315 18 A18 Z 517               A17 C 716   A17 Z 516   A17 Y 316 19                   A18 C 717   A18 Z 517   A18 Y 317 20                   A19 C 718   A19 Z 518   A19 Y 318 21                   A20 C 719   A20 Z519   A20 Y 319
Spreadsheet Formulas Cell Formula B1 =VLOOKUP(A1,Table1,2,0) B2 =VLOOKUP(A2,Table1,2,0) B3 =VLOOKUP(A3,Table1,2,0) B4 =VLOOKUP(A4,Table1,2,0) B5 =VLOOKUP(A5,Table3,2,0) B6 =VLOOKUP(A6,Table3,2,0) B7 =VLOOKUP(A7,Table3,2,0) B8 =VLOOKUP(A8,Table3,2,0) B9 =VLOOKUP(A9,Table3,2,0) B10 =VLOOKUP(A10,Table3,2,0) B11 =VLOOKUP(A11,Table3,2,0) B12 =VLOOKUP(A12,Table3,2,0) B13 =VLOOKUP(A13,Table3,2,0) B14 =VLOOKUP(A14,Table2,2,0) B15 =VLOOKUP(A15,Table2,2,0) B16 =VLOOKUP(A16,Table2,2,0) B17 =VLOOKUP(A17,Table2,2,0) B18 =VLOOKUP(A18,Table2,2,0)

Excel tables to the web >> Excel Jeanie HTML 4


Hello,

I have a piece of code to vlookup. The setup is as follows.
There are 2 sheets used for the Vlookup. Sheet"B1 Movements" which has the value to lookup and sheet "Movement Box" which has the range to look up from. the resulting value of the vlookup must be in column M of sheet "B1 Movements". whenever I try to run this code, I get a 1004 error "application defined or object defined error". If I add "on error resume next", it still does not work.... below is the code that I am using.

VB:

Sub vlookup_names() 
    Dim x As String 
     
    With Sheets("B1 Movements") 
        Do 
            x = Application.WorksheetFunction.VLookup(ActiveCell.Offset(0, -10).Value, Worksheets("Movement Box").Range("C1:M100"), 11, False) 
            ActiveCell.Value = x 
            ActiveCell.Offset(1, 0).Select 
        Loop Until IsEmpty(ActiveCell.Offset(0, -10)) 
    End With 
     
End Sub 


If you like these VB formatting tags please consider sponsoring me in support of injured Royal Marines



Any help is appreciated.

Greetings!

I am having a difficulty with the following code. In my first sheet I wish to have a column where each cell contain a hyperlink to one of my sheets, so I can easily access any of them without having to scroll horizontally. This is the code:
VB:

Sub LkClients() 
     
    Application.ScreenUpdating = False 
     
    Dim i As Integer 
    For i = 1 To Sheets.Count 
         
        ActiveSheet.Cells(i, 1).Select 
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _ 
        "Monthly_Hours.xls", SubAddress:=Sheets(i).Name, _ 
        TextToDisplay:=Sheets(i).Name 
         
        Application.ScreenUpdating = True 
         
    Next i 
     
End Sub 


If you like these VB formatting tags please consider sponsoring me in support of injured Royal Marines



It works in its task to create the hyperlinks filling the A column with it, naming after each sheet. BUT the hyperlink doesnt refer correctly if, in the address, I dont indicate a cell within each sheet. (Monthly_Hours.xls#Friday!A1 works perfectly as the address, but Montly_Hours.xls#Friday gives me invalid reference)

I cant find a way to insert the "!A6" info after the "SubAddress:=Sheets(i).Name" without crashing the code. Could anyone give me a hand?

Appreciate it.

hi, i am trying to do lookup in sheet "Rawdata", while referencing table sheet "CFG", but when i run till b=application.worksheetFunction.vlookup, it always prompt error msg "unable to get the vlookup property of the worksheetfunction class", can help? Thanks
-----------------------
VB:

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 


If you like these VB formatting tags please consider sponsoring me in support of injured Royal Marines




I got this code for selecting and copying data to another sheet but it does not stop looping any suggestions?


VB:

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 


If you like these VB formatting tags please consider sponsoring me in support of injured Royal Marines




I've got four tables with negative and positive values and want to determine the largest magnitude of a subset of four values within those four tables. In other words if the largest magnitude is negative I want the negative value of the four subsets or vise-versa.

I've tried the following but got an error stating it was too long:

= IF(ABS(VLOOKUP(table1)) = MAX(ABS(VLOOKUP(table1)), ABS(VLOOKUP(table2)), ABS(VLOOKUP(table3)), ABS(VLOOKUP(table4))), VLOOKUP(table1), IF(ABS(VLOOKUP(table2)) = MAX(ABS(VLOOKUP(table1)), ABS(VLOOKUP(table2)), ABS(VLOOKUP(table3)), ABS(VLOOKUP(table4))), VLOOKUP(table2), IF(ABS(VLOOKUP(table3)) = MAX(ABS(VLOOKUP(table1)), ABS(VLOOKUP(table2)), ABS(VLOOKUP(table3)), ABS(VLOOKUP(table4))), VLOOKUP(table3), VLOOKUP(table4))))

The repeating line needs attention in my mind:

MAX(ABS(VLOOKUP(table1)), ABS(VLOOKUP(table2)), ABS(VLOOKUP(table3)), ABS(VLOOKUP(table4)))

Thanks


I've got four tables with negative and positive values and want to determine the largest magnitude of a subset of four values within those four tables. In other words if the largest magnitude is negative I want the negative value of the four subsets or vise-versa.

I've tried the following but got an error stating it was too long:

= IF(ABS(VLOOKUP(table1)) = MAX(ABS(VLOOKUP(table1)), ABS(VLOOKUP(table2)), ABS(VLOOKUP(table3)), ABS(VLOOKUP(table4))), VLOOKUP(table1), IF(ABS(VLOOKUP(table2)) = MAX(ABS(VLOOKUP(table1)), ABS(VLOOKUP(table2)), ABS(VLOOKUP(table3)), ABS(VLOOKUP(table4))), VLOOKUP(table2), IF(ABS(VLOOKUP(table3)) = MAX(ABS(VLOOKUP(table1)), ABS(VLOOKUP(table2)), ABS(VLOOKUP(table3)), ABS(VLOOKUP(table4))), VLOOKUP(table3), VLOOKUP(table4))))

The repeating line needs attention in my mind:

MAX(ABS(VLOOKUP(table1)), ABS(VLOOKUP(table2)), ABS(VLOOKUP(table3)), ABS(VLOOKUP(table4)))

Thanks


Here is my attempt.

=IF(A1="table1",VLOOKUP(B4,Matrix.xls!table1,2,1)*B6),IF(A1="table2",VLOOKUP(B4,Matrix.xls!table2,2,1)*B6),IF(A1="table3",VLOOKUP(B4,Matrix.xls!table3,2,1)*B6),IF(A1="table4",VLOOKUP(B4,Matrix.xls!table4,2,1)*B6),""))))

I have a validation in cell A1 with a dropdown list, table1,table2,table3,table4.

I want to be able to select that and then pull data from the matrix sheet based on the ranges with the same name using a vlookup returning the 2nd column.

Is this possible using this formula? Think I may be barking up the wrong tree here.

Thank you


Hi Guys,

New to this forum and my first post

I have tried searching for this question before but am still having trouble (perhaps not using the right keywords!).

Basically, I have the following code:

VB:

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


If you like these VB formatting tags please consider sponsoring me in support of injured Royal Marines



I want MyMonth to be defined by the user because the spreadsheet I am using will have a different tab name each month e.g. May TOTAL then Jun TOTAL.

What do you guys think I'm doing wrong?

Any help would be greatly appreciated

Cheers.

I want to make a very basic text encoder to change a text string to a long number. (Yes I know its not very secure!)

This is what I have so far but I cant get the VLookup to work properly...

Code:

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


The Text to encode is in A1 and the table to lookup is Y1:Z95

If you have any suggestions of other ways to do it please bear in mind I do need the output to be all numbers, not other odd characters.


Hey,

Currently I have this code:

VB:

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 


If you like these VB formatting tags please consider sponsoring me in support of injured Royal Marines



The issue i'm having is that I want the text which is copied to actually add a new row (So i'm making a table of my clients details but using another page to type the information in and the macro to paste it into the contacts sheet) Hope i explained it well enough!

I think I got it. Thanks for all your help


Sorry, I changed the font. I hope this is the correct way.

Here is a copy of my code and I am Having a problem trying to get it to filter zero balances out. There are positive and negative numbers and I need to post them to a seperate sheet and exclude all zeros. Any help would be appreicated and If there is a way to shorten the code that would help too. Thanks in advance


Code:

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





Hi all,
I love vlookup, but for years I have wanted to tidy up the results when not found.
I know I could do something complicated, like using an extra column, or calling vlookup twice,
but today I thought I'd pop in a VBA function to do it, something like:

Public Function tidy(ByVal myString As String) As String
tidy = myString
If myString = "#N/A" Then tidy = ""
End Function

Then I can do:
=tidy(vlookup(a1,stuff,1,false))

Alas when vlookup returns an error, my tidy function isn't called.
Any nice neat suggestions?
Thanks.


I have a vlookup table with will define the Job description based on the job number & cost code. The function is working fine but the problem come when i try to convert it into macro. Below is the code

Code:

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


I attach here with my file.

Sheet 'Data' contains the raw data with the vlookup formula which works fine.
Sheet 'Info' contain the lookup table.
Sheet 'Data2' are the one which i try to run the macro code on.

I have try to alter my code many times but still can't work. Appreciate if someone can help me with this.

Thanks!!


Morning all,

I have done a Macro in Excel 2003 to copy and paste infomation from one sheet to my form I have setup in another sheet.

Can someone add to my macro so it continues copying the the data down the rows until it reaches a blank row, please

Many thanks.

Code:

'
' 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





Dear All,

I have the following code (see below) that prompts the user for a Text string, then it searches for this string in Sheet1/ColA, and then moves that cell to Sheet2.

The problem is that I would like to move the whole row where the matched cell is contained, not only the cell itself.

How would you ammend the code to do that ?

Any help would be appreciated.

Thanks.


Code:

    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





Hi All,

The below code was picked up from this forum and one of this forum members has helped in copying the Value and Format and placing it in the new sheet.

I am trying to select a sheet to be copied via macro which is not working. I am absolutely new to coding and request the team to excuse me if there is a silly coding mistake.

Below is the objective:

Quote:

The macro should give a dialogue box to select the Input Sheet to be copied rather than explicitly specifying "Sheet Name" in the code

Best Regards,
Srikanth

Code:

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


Would like to implement the above in the below code:

Code:

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





I would like to use an input box to ask the user to select a range that may be another sheet. If it is on another sheet, the returned range references only the cells without the sheet. How can I return the source sheet too?

Set myrange = Application.InputBox(Prompt:="Choose a range", Title:="Choose", Type:=8)

'User selects a range on another sheet....
mystring = myrange.Address

Any guidance would be appreciated. Thanks


Good Day,

I have a macro that extracts text from multiple worksheets and places it in a column along with the cell reference and worksheet name. I'd like to do the same thing but instead of text I'd like it to pull formulas with text only. Some of the formulas have more than one word associated with them.

EX:

=IF($B34="","Enter Part Number",IF($D34="","Enter OEM",IF($F34="","Enter Quantity",IF($G34="","Enter Published List Unit Price",IF(VLOOKUP($D34,LAN_Range,2,FALSE)="","Enter NE Discount",($G34-(VLOOKUP($D34,LAN_Range,2,FALSE)*$G34))*$F34)))))

Here's the current formula:

VB:

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 


If you like these VB formatting tags please consider sponsoring me in support of injured Royal Marines



Any help would be appreciated...

Thanks!

Hi there,

I am trying to loop thorugh all pivot tables and if the pivot table has the field named "Chg Procedure Code" then hide certain pivotitems (depending on what is entered in the input box).

Without the .autosort xlManual part, I got a run time error '1004' Unable to set the visisble property of the Pivotitem class. Then I added the.autosort xlManual and keep getting an error on this part (run time error '450") Wrong number of arguments or invalid property assignment.

Any help on this will be appreciated. Below is the code I am working with:

VB:

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 


If you like these VB formatting tags please consider sponsoring me in support of injured Royal Marines




I have the a code, which runs fine if vlookup returns #N/A but if it returns a value, i get a Type mismatch error,

VB:

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 


If you like these VB formatting tags please consider sponsoring me in support of injured Royal Marines



how do i modify the if condition as not to get an error when Vlookup returns a value.

Thanks in advance.
McFerra

Hi, I currently have a workbook with a number of sheets. Each sheet needs to be emailed to a different person based on an identifier in that sheet. Is there anyway to create a macro that will use a column to look up the email address against another sheet (vlookup) and run through the entire workbook of sheets? Please let me know if this is confusing. I want the sheets sent in the body of the email and not as attachments. I have the following basic code but it does not look like the Vlookup formula can work in this situation.

Sub Send_Range()
ActiveSheet.Range("A1:J58").Select

ActiveWorkbook.EnvelopeVisible = True

With ActiveSheet.MailEnvelope
.Item.To = "VLOOKUP(G2,CONTACTS!A:B,2,FALSE)"
.Item.Subject = "My subject"
.Item
End With

End Sub

All help is greatly appreciated.

Thanks,
Mark


Does anyone know how to get the cells address from a vlookup funtion in a macro, Im relatively new to excel and learning fast, but keep comin up against brick walls!

What I have done, is a lookup sheet where i type in a number and if its found in a table in another sheet, it returns values from other columns, ie name/address, but i want to be able to select the name from my lookup sheet and mark it by painting the cell, the painting bit i can do, i just cant figure out how to get the cells address from the vlookup function, any ideas?

ie,

Sheets("Lookup").Select
Range("G5").Select ' my lookup value is in this box
' c[-6]:c[3] = A:J
ActiveCell.FormulaR1C1 = "=VLOOKUP(R5C7,'Phone List'!C[-6]:C[3],6,FALSE)"

' i have place a button on the sheet with this code:

Sheets("Phone List").Select
'Range(" --- here i need an address --- ").Select
ActiveCell.Select
' paint yellow
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
' go back to lookup sheet
Sheets("Lookup").Select


please help me .... thanks