I have the following code which I am trying to get to name the entire A and B columns range according to the worksheet tab name. I want each A:B range of cells in each worksheet to be named RoomCode_ + the name of the excel sheet tab.
So for example if I had 3 sheets called XYZ, ABC and DEF, then my cell range names for those 3 sheets respectively should be:
RoomCode_XYZ
RoomCode_ABC
RoomCode_DEF
I would typically do this manually by highlighting the cell range and just typing the range name I wanted, however I have over 150 tabs and would like to be able to do them all automatically through this process.
Sub nameRanges()
Set wbook = ActiveWorkbook
For Each sht In wbook.Worksheets
sht.Activate
RangeName = "RoomCode_" + ActiveSheet.Name
CellName = "A:B"
Set cell = ActiveWorksheets.Range(CellName)
ActiveWorksheets.Names.Add Name:=RangeName, RefersTo:=cell
Next sht
End Sub
Just a bit of refactoring to get what you need. Biggest this to work directly with objects and eliminate the Active... stuff.
Also ActiveWorksheets is not proper syntax in any way.
Sub nameRanges()
Dim wbook As Workbook
Set wbook = ThisWorkbook
Dim sht As Worksheet
For Each sht In wbook.Worksheets
Dim RangeName As String, CellName As String
RangeName = "RoomCode_" + sht.Name
CellName = "A:B"
Dim cell As Range
Set cell = sht.Range(CellName)
sht.Names.Add Name:=RangeName, RefersTo:=cell
Next sht
End Sub
Here's another way:
Option Explicit
Sub nameRanges()
Dim sht As Worksheet
Dim RangeName As String
Dim cell As String
For Each sht In ActiveWorkbook.Worksheets
RangeName = "RoomCode_" + sht.Name
cell = "=" & sht.Name & "!" & "A:B"
Names.Add Name:=RangeName, RefersTo:=cell
Next sht
End Sub
I think that you would want to add the names to the workbook names collection. The way it is now you'll still have to reference the individual worksheet before you can access the name.
WorkSheets("RoomCode").Range("RoomCode_XYZ")
By adding the names to the workbook you'll be able to access no matter the ActiveSheet.
Range("RoomCode_XYZ")
Sub nameRanges()
Dim wbook As Workbook
Set wbook = ThisWorkbook
Dim sht As Worksheet
For Each sht In wbook.Worksheets
Dim RangeName As String, CellName As String
RangeName = "RoomCode_" + sht.Name
CellName = "A:B"
Dim cell As Range
Set cell = sht.Range(CellName)
ThisWorkBook.Names.Add Name:=RangeName, RefersTo:=cell
Next sht
End Sub
Related
I have a workbook made up with 100+ worksheets. These worksheets have account number/names/days in the name of the worksheet.
The naming convention for the worksheets follows this pattern of AccountNumber/AccountName/Description:
11-Greg-Monday
11-Greg-Tuesday
11-Greg-Friday
38-Rachel-Sunday
38-Rachel-Tuesday
38-Rachel-Saturday
I would like Excel to loop through all the worksheets, and extract all of the 11-Greg worksheets and save into a new workbook named 11-Greg, and then do the same for 38-Rachel, etc. I have a list of the account numbers/names on a worksheet named "Accounts" in the workbook.
Would it be possible to maintain the formulas after the extract of the worksheets, and formatting like column widths?
I found this code that might work to start, but I don't know how to reference the list on the "Accounts" tab to loop through for the account names?
Dim wb as Workbook, sht as WorkSheet
Dim strFileName As String
'Copy sheet as a new workbook
ActiveWorkbook.Sheets("Sheet1").Copy
Set wb = ActiveWorkbook
Set sht = wb.Sheets(1)
'SaveAs
strFileName = Application.GetSaveAsFilename(wb.Name) & "xlsx"
If strFileName = "False" Then Exit Sub 'User Canceled
wb.SaveAs Filename:=strFileName
The easiest way would be to create a list of the names you want to stack on a separate list. set that list as a range and then loop through each cell checking to see if the x letters of the sheet name match. something like this
Sub stacksheets()
Dim rng As Range, cCell As Range
Dim ws As Worksheet
Dim wb As Workbook, wb2 As Workbook
Dim shName As String
Set rng = ActiveWorkbook.Sheets("list").Range("a1:a2") ''this would be the list of names
Set wb2 = ActiveWorkbook ''remembering activeworkbook so can return
For Each cCell In rng
shName = Left(cCell.Value, 5) ''this needs to be the minimum letters from each name that is unique
Set wb = Workbooks.Add
For Each ws In wb2.Sheets
If InStr(ws.Name, shName) > 0 Then ''checks for name in sheet name
ws.Copy after:=wb.Sheets(1)
wb2.Activate
End If
Next ws
wb.SaveAs (wb2.Path & "\" & cCell.Value) '' saves workbook as list name
Next cCell
End Sub
I am using VBA to try to see if values in cells from one workbook match the named ranges from another workbook and if they do match then copy paste values from another column in those named ranges. I know they will match. the purpose is just to copy the values over into their designated named range.
The problem is in this line:
If rng = ws2.Range("NamedRange") Then
Here is my code below:
Sub Button4_Click()
Dim strFileName As String
Dim wb1 As Workbook
Dim ws1 As Worksheet
Dim wb2 As Workbook
Dim ws2 As Worksheet
Dim cell As Range
Dim rng As Range
Dim RangeName As String
Dim CellName As String
''Set wb2 = ActiveWorkbook
''Set ws2 = wb2.Sheet("Output")
''ws2.Range("D1:D12").Copy
''Set wb1 = ActiveWorkbook
strFileName = CreateObject("WScript.Shell").specialfolders("Desktop") & "\BAC GVP - Template_Update_121917.xlsm"
If Dir(strFileName) <> vbNullString Then
Set wb1 = Workbooks.Open(strFileName)
Else
MsgBox "Sorry, the file does not exist on your Desktop at this time, please drop a copy to your Desktop from server!"
End If
''Set wb2 = ThisWorkbook
''Set ws2 = wb2.Sheets("Output")
''Set ws1 = wb1.Sheets("RVP Local GAAP")
''ws2.Range("D4:D12").Copy
''ws1.Range("G13:G21").PasteSpecial xlPasteValues
''RangeName = "myData"
''CellName = "G11:G83"
''Set cell = Worksheets("RVP Local GAAP").Range(CellName)
''ThisWorkbook.Names.Add Name:=RangeName, RefersTo:=cell
''RangeName = "NamedRange"
''CellName = "C4:C12"
Set wb2 = ThisWorkbook
Set ws2 = wb2.Sheets("Output")
Set ws1 = wb1.Sheets("RVP Local GAAP")
For Each rng In ws1.Range("CurrentTaxPerLocalGAAPProvision")
If rng = ws2.Range("NamedRange") Then
ws2.Range("ReportBalance").Copy
ws1.Range("CurrentTaxPerLocalGAAPProvision").PasteSpecial xlPasteValues
MsgBox "Values Copied Successfully"
End If
Next rng
MsgBox "Both Ranges do not have the same data"
End Sub
See image below - Cell G29 is called "GVP_Donations_CurrentTaxPerLocalGAAPProvision"... so for this example I would want $4,313 to appear in the cell G29
CurrentTaxPerLocalGAAPProvision:
Range ("NameRange"):
Your line saying
If rng = ws2.Range("NamedRange") Then
is crashing out due to the attempt to compare the value of rng (e.g. "" when rng is referring to the cell G29) with an array of values (the values in "NamedRange"). VBA cannot handle the comparison of a scalar to a vector. But it isn't what you are wanting to do anyway.
I believe that, to do what it seems you are trying to do, you can replace your loop with:
'Loop through all the values in NamedRange
For Each rng In ws2.Range("NamedRange")
'Transfer the value from the next column to the appropriate range in the
'destination sheet
ws1.Range(rng.Value).Value = rng.Offset(0, 1).Value
Next
MsgBox "Values Copied Successfully"
If only some of the values in "NamedRange" should be copied, then you may need to include a bit of testing to see whether the ranges are in the correct target area:
Dim dstRng As Range
'Loop through all the values in NamedRange
For Each rng In ws2.Range("NamedRange")
Set dstRng = Nothing
On Error Resume Next
Set dstRng = ws1.Range(rng.Value)
On Error GoTo 0
'Check that the range exists in destination sheet
If Not dstRng Is Nothing Then
'Check that the range exists in the appropriate area
If Not Intersect(dstRng, ws1.Range("CurrentTaxPerLocalGAAPProvision")) Is Nothing Then
'Transfer the value from the next column to the appropriate range in the
'destination sheet
dstRng.Value = rng.Offset(0, 1).Value
End If
End If
Next
MsgBox "Values Copied Successfully"
why does this code run fine:
Sub SelectRange()
Dim sourceBook As Workbook
Dim sourceSheet As Worksheet
Dim sourceSheetSum As Worksheet
Set sourceBook = ActiveWorkbook
Set sourceSheet = sourceBook.Sheets("Tabelle1")
ActiveWorkbook.Names.Add _
Name:="ggg", _
RefersTo:="=Sheet1!A4:L37"
sourceSheet.Select
sourceSheet.Range("A4:L37").Select
End Sub
However if I change
sourceSheet.Range("A4:L37").Select
to:
sourceSheet.Range("ggg").Select
I receive a run-time error 1004
Try the code below, it will create "ggg" named range from cells "A4:L37" in "Tabelle1" sheet.
Afterwards, it sets another Range MyNamedRange to the named Range("ggg") - this step is not necessary, I just like to work with variables for Range.
At the end, it selects MyNamedRange.
Code
Sub SelectRange()
Dim sourceBook As Workbook
Dim sourceSheet As Worksheet
Dim sourceSheetSum As Worksheet
Dim MyNamedRange As Range
Set sourceBook = ActiveWorkbook
Set sourceSheet = sourceBook.Sheets("Tabelle1")
' create the named range "ggg"
sourceBook.Names.Add _
Name:="ggg", _
RefersTo:="=" & sourceSheet.Name & "!A4:L37"
Set MyNamedRange = Range("ggg") ' <-- set the Range to your NamedRange "ggg"
sourceSheet.Activate '<-- activate the sheet first
MyNamedRange.Select '<-- select the Named Range
End Sub
Try this:
SourceSheet.Range(Names.Item("ggg")).Select
I am trying to copy over values from one workbook to another using the usedrange function (there are some blanks in certain rows and it is fine to copy over the blank as well), but I am getting the 1004 error:
Sub ActiveInactiveVendors()
Dim ActiveWkb As Workbook, Wkb As Workbook, InactiveWkb As Workbook
Dim ActiveWkst As Worksheet, Wkst As Worksheet, InactiveWkst As Worksheet
Dim aCell As Range
Dim targetRng As Range
Set ActiveWkb = Workbooks.Open("C:\Users\clara\Desktop\active vendors.xlsx")
Set Wkb = ThisWorkbook
Set Wkst = Wkb.Sheets("Vendors")
Set ActiveWkst = ActiveWkb.Worksheets("aqlc7da48e7")
'set column A starting from A7
Set targetRng = Wkst.Range("A7" & Wkst.Rows.Count)
'get the values starting from a32 to the last row used and set it in wkst
targetRng.Value = ActiveWkst.Range("A32" & ActiveWkst.UsedRange.Rows.Count).Value
End Sub
I appreciate any feedback! Thank you
This line:
Set targetRng = Wkst.Range("A7" & Wkst.Rows.Count)
is not correct. You are not getting A7:A1048576 but a concatenating of the two. So it is looking for A71048576 which does not exist
Then you should use similar sized ranges when setting values.
Sub ActiveInactiveVendors()
Dim ActiveWkb As Workbook, Wkb As Workbook, InactiveWkb As Workbook
Dim ActiveWkst As Worksheet, Wkst As Worksheet, InactiveWkst As Worksheet
Dim aCell As Range
Dim targetRng As Range, origRng As Range
Set ActiveWkb = Workbooks.Open("C:\Users\clara\Desktop\active vendors.xlsx")
Set Wkb = ThisWorkbook
Set Wkst = Wkb.Sheets("Vendors")
Set ActiveWkst = ActiveWkb.Worksheets("aqlc7da48e7")
'set column A starting from A7
Set origRng = ActiveWkst.Range("A32", ActiveWkst.Cells(ActiveWkst.Rows.Count, 1).End(xlUp))
Set targetRng = Wkst.Range("A7", Wkst.Cells(origRng.Rows.Count + 6, 1))
'get the values starting from a32 to the last row used and set it in wkst
targetRng.Value = origRng.Value
End Sub
What I am trying to do seems basic enough, however I don't know where I am going wrong with the code.
I want to run the selected cell through a loop of the worksheets and select the worksheet that matches the selected cell located in cell B1.
Dim SelectedCell as Range
Dim ws As Worksheet
Set SelectedCell = Range(ActiveCell.Address)
For Each ws In ActiveWorkbook.Worksheets
If ws.Range("B1").Value = SelectedCell.Value Then
ActiveSheet.Select
End If
Next ws
End Sub
Thanks in advance for all the help!
Try instead
Dim ws As Worksheet
SelectedCell = ActiveCell
For Each ws In ActiveWorkbook.Worksheets
If ws.cells(1,2) = SelectedCell Then
ws.Select
End If
Next ws
End Sub
Select cell run macro will select the sheet name that matches the selected cell. (Case sensitive)
Dim SelectCell As String
Dim ws As Worksheet
SelectCell = ActiveCell.Value2
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = SelectCell Then
ws.Select
End ID
Next ws