I have 3 sheets and 1 master sheets.
I want to copy cell data in master to rest of the sheets.
It always thrw "Runtime error 1004. can anyone help?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Master")
Dim columnName As String
columnName = Split(ActiveCell.Address, "$")(1)
Sheets.FillAcrossSheets ws.Range(columnName & ActiveCell.Row), xlFillWithAll
End Sub
All sheets should be assigned to array and the range to fill must be from a sheet within the array. Try this
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim shtArray As Variant
shtArray = Array("Master", "Sheet1", "Sheet2", "Sheet3")
Set ws = ThisWorkbook.Sheets("Master")
Sheets(shtArray).FillAcrossSheets Target
'Dim columnName As String
'columnName = Split(ActiveCell.Address, "$")(1)
'Sheets(shtArray).FillAcrossSheets ws.Range(columnName & ActiveCell.Row), xlFillWithAll
End Sub
Related
I am trying to write a macro that will prompt the user to open 2 workbooks and then loop through the worksheets in the 2 books comparing their contents and highlighting any differences in yellow. Each piece seems to be working on its own, but I cannot figure out how to set the workbook names as global variables to be used between the functions in my sub. Any help would be appreciated! :)
Public strFile1 As String
Public strFile2 As String
Public wbSource1 As Workbook
Public wbSource2 As Workbook
Public I As Integer
Sub DifferenceCheckBetweenBooks()
Call openIt
Call WorksheetLoop
End Sub
Function openIt()
strFile1 = Application.GetOpenFilename
Workbooks.Open strFile1
Set wbSource1 = Workbooks.Open(strFile1)
strFile2 = Application.GetOpenFilename
Workbooks.Open strFile2
Set wbSource2 = Workbooks.Open(strFile2)
End Function
Function WorksheetLoop()
Dim WS_Count As Integer
WS_Count = Workbooks(wbSource1).Worksheets.Count
' Begin the loop.
For I = 1 To WS_Count
Call compareBooks
Next I
End Function
Function compareBooks()
Dim mycell As Range
'For each cell in worksheet that is not the same as compared worksheet, color it yellow
For Each mycell In Workbooks(wbSource1).Worksheets(I).UsedRange
If Not mycell.Value = Workbooks(wbSource2).Worksheets(I).Cells(mycell.Row, mycell.Column).Value Then
mycell.Interior.Color = vbYellow
Workbooks(wbSource2).Worksheets(I).Cells(mycell.Row, mycell.Column).Interior.Color = vbYellow
End If
Next
Workbooks(wbSource2).Worksheets(I).Select
End Function
I am getting the classic "subscript out of range error" which points to my wbSource1 variable as empty.
Don't do this
Workbooks.Open strFile1
Set wbSource1 = Workbooks.Open(strFile1)
you only need
Set wbSource1 = Workbooks.Open(strFile1)
And as SJR points out:
WS_Count = wbSource1.Worksheets.Count 'plus all other instances of this
You should really refactor your code to remove the globals and use parameters in your methods instead - that's a much safer approach.
Refactored to remove globals:
Sub DifferenceCheckBetweenBooks()
Dim wb1 As Workbook, wb2 As Workbook
Set wb1 = OpenIt("Choose first file")
If wb1 Is Nothing Then Exit Sub
Set wb2 = OpenIt("Choose second file")
If wb2 Is Nothing Then Exit Sub
CompareWorkbooks wb1, wb2
End Sub
Sub CompareWorkbooks(wb1 As Workbook, wb2 As Workbook)
Dim i As Long, sht1 As Worksheet, sht2 As Worksheet, c As Range, c2 As Range
For i = 1 To wb1.Worksheets.Count
Set sht1 = wb1.Worksheets(i)
Set sht2 = wb2.Worksheets(i)
For Each c In sht1.UsedRange.Cells
Set c2 = sht2.Range(c.Address)
If c.Value <> c2.Value Then
c.Interior.Color = vbYellow
c2.Interior.Color = vbYellow
End If
Next c
Next i
End Sub
Function OpenIt(msg As String) As Workbook
Dim strFile
strFile = Application.GetOpenFilename(Title:=msg)
If Len(strFile) > 0 Then Set OpenIt = Workbooks.Open(strFile)
End Function
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've got a script that deletes rows 1-4 on on every worksheet, but would like it to skip a worksheet if its name is "Sheet1"
Sub RowDelete()
Dim xWs As Worksheet
Set xWs = ActiveSheet
ThisWorkbook.Worksheets.Select
Rows("1:4").Select
Selection.Delete
xWs.Select
End Sub
Run it through a FOR EACH Loop:
Sub RowDelete()
Dim xWs As Worksheet
For Each xWs In Worksheets
If xWs.Name <> "Sheet1" Then
xWs.Rows("1:4").Delete
End If
Next xWs
End Sub
Btw, try to learn coding without using .Select.
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
I would appreciate your help with the macro I am trying to create.
I have an xls file with a bunch of worksheets, some of which named "1", "2", "3", and so forth. I would like to create a macro that loops only through those 'number-named' worksheets, hence NOT according to the index as in the code below. (Sheet "1" is not the first sheet in the workbook). Before the loop I need to define both the cell range and sheets.
Below is my (wrong) attempt.
Sub Refresh ()
Dim i As Integer
Dim rng As Range
Set rng = Range("A10:TZ180")
For i = 1 To 30
Sheets(i).Activate
rng.Select
rng.ClearContents
Application.Run macro:="xxx"
Next i
End Sub
dim w as worksheet
for each w in activeworkbook.worksheets
if isnumeric(w.name) then
w.range("A10:TZ180").clearcontents
xxx()
end if
next
If the macro "xxx()" requires a selected range you just need to add a select statement. (Borrowing from GSerg)
Dim w As Worksheet
For Each w In ActiveWorkbook.Worksheets
If IsNumeric(w.Name) Then
w.Range("A10:TZ180").ClearContents
w.Range("A10:TZ180").Select
Application.Run macro:="xxx"
End If
Next
To clear up your misunderstanding about assigning a range see the following:
Sub Refresh()
Dim ws As Worksheet
Dim rng As Range
Dim i As Integer
For Each ws In ActiveWorkbook.Worksheets
If IsNumeric(ws.Name) Then
'you must activate the worksheet before selecting a range on it
ws.Activate
'note the qualifier: ws.range()
Set rng = ws.Range("A10:TZ180")
'since the range is on the active sheet, we can select it
rng.Select
rng.ClearContents
Application.Run macro:="xxx"
End If
Next
End Sub
Sub test2()
Dim ws As Worksheet
Dim rg As Range
Dim arrSheets As Variant
arrSheets = Array("Sheet1", "Sheet2", "Sheet3")
Dim x As Long
For x = LBound(arrSheets) To UBound(arrSheets)
Set ws = Worksheets(arrSheets(x))
ws.Activate
'...
Next
End Sub
Sub test3()
Dim ws As Worksheet
Dim x As Long
For x = 1 To 20
Set ws = Worksheets(CStr(x))
ws.Activate
'...
Next
End Sub
try this
Sub main()
Dim shtNames As Variant, shtName As Variant
shtNames = Array(1, 2, 3, 4) '<== put your actual sheets "number name"
For Each shtName In shtNames
With Worksheets(CStr(shtName))
.Range("A10:TZ180").ClearContents
.Range("A10:TZ180").Select
Application.Run macro:="MacroToRun"
End With
Next shtName
End Sub
Sub MacroToRun()
MsgBox "hello from cells '" & Selection.Address & "' in sheet '" & ActiveCell.Parent.Name & "'"
End Sub