
Vba Macro To Name Sheets Based On Lookup Results


Search Excel Forum Posts, Tutorials, Macros, Tips, and More
Vba Macro To Name Sheets Based On Lookup Results  Excel

View Answers


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
Lookup Adding: SUMPRODUCT & SUMIF
 See how to use the SUMPRODUCT & SUMIF functions together to Lookup multiple items and add them in one cell. This method is great when you have man ...
Get Last Value from Multiple Sheets
 See how to get the last value in Column B from across many sheets using the LOOKUP and INDIRECT functions. This is from a post at the Mr Excel Message ...
Similar Topics
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
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 BD, 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 BD 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 viseversa.
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 viseversa.
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

