Going crazy here. I use this definition of worksheet all the time. Copied every string to avoid typing errors. Still, the code below produces "Nothing" when I try to set FR worksheet. Pls help!
Sub FindReplace()
Dim FRep As Worksheet
Dim c As Range
Dim cText As TextBox
Dim i As Integer
Set FRep = ThisWorkbook.Worksheets("FindReplace")
For i = 1 To 23
cText = FRep.Cells(i, 3).Text
FRep.Cells(i, 2).NumberFormat = "#"
FRep.Cells(i, 2).Value = cText
Next i
The code as is seems correct. Make sure that "FindReplace" worksheet is in ThisWorkbook.
Also, you can try to get "FindReplace" worksheet by CodeName instead of by the name of the sheet. The advantage is that if the user changes the name of the worksheet, the CodeName will remain the same and you won't need to update your code to the new worksheet name.
Public Function GetWsFromCodeName(codeName As String, wb As Workbook) As Worksheet
Dim ws As Worksheet
For Each ws In wb.Worksheets
If ws.CodeName = codeName Then
Set GetWsFromCodeName = ws
Exit For
End If
Next ws
End Function
Add this function in your code:
Sub FindReplace()
Dim FRep As Worksheet
Set FRep = GetWsFromCodeName("YourCodeName", ThisWorkbook)
Related
I am trying to use VBA to loop through worksheets in my file but only those that are included in a list on a control worksheet, e.g.
Worksheet List
When I try to look up the worksheet name in this list, it does not recognise the worksheet name as a string.
Current code below:
I create a function to vlookup on the list:
Public Function IsInRunList(WsName As Variant, RunList As Range) As Boolean
If Application.VLookup(WsName, RunList, 1, False) = WsName Then
IsInRunList = True
End If
End Function
Then I call this function in my subroutine:
Dim Ws As Worksheet
For Each Ws In ThisWorkbook.Worksheets
If IsInRunList(Ws.Name, Range("Run_List").Columns(j)) Then
I get a mismatch error for Ws.Name here.
Any ideas?
Thanks.
Try the next approach, please:
Sub iterateBetweenSheetInList()
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
Select Case sh.Name
Case "Sheet1", "Sheet2", "Sheet4", "Sheet7"
Debug.Print sh.UsedRange.Rows.Count
'your code can do here whatever you need...
End Select
Next
End Sub
Or a version to take the sheets name from a range (in column X:X in the code example). You did not show us in which column the sheets list exists:
Sub iterateBetweenSheetInListBis()
Dim sh As Worksheet, ws As Worksheet, arrSh As Variant, El As Variant
Set sh = ActiveSheet
'adapt the next range with the lettr of your column where the sheets name exists:
arrSh = sh.Range("X2:X" & sh.Range("X" & Rows.Count).End(xlUp).row).Value
For Each El In arrSh
Set ws = Worksheets(El)
Debug.Print ws.UsedRange.Rows.Count
'do here whatever you need...
Next
End Sub
Application.VLookup returns a Range when successful and an error if not (same behavior as in Excel). An error is not a string, it's a special type that you can check with IsError.
Change your checking routine to something like:
Public Function IsInRunList(WsName As Variant, RunList As Range) As Boolean
Dim res As Variant
res = Application.VLookup(WsName, RunList, 1, False)
IsInRunList = Not IsError(res)
End Function
Currently this macro splits worksheets based on a cell.
It works well, however I am putting it as a button on a different page but this selects the active page, I want it to run this macro on a specific sheet.
Sub SplitToWorksheets_step4()
'Splits the workbook into different tabs
Dim ColHead As String
Dim ColHeadCell As Range
Dim icol As Integer
Dim iRow As Long 'row index on Fan Data sheet
Dim Lrow As Integer 'row index on individual destination sheet
Dim Dsheet As Worksheet 'destination worksheet
Dim Fsheet As Worksheet 'fan data worksheet (assumed active)
Again:
'ColHead = Worksheets("Diversion Report") 'this ask the user to enter a colunm name
ColHead = InputBox("Enter Column Heading", "Identify Column", [c1].Value) 'this ask the user to enter a colunm name
If ColHead = "" Then Exit Sub
Set ColHeadCell = Rows(1).Find(ColHead, LookAt:=xlWhole)
If ColHeadCell Is Nothing Then
MsgBox "Heading not found in row 1"
GoTo Again
End If
Set Fsheet = ActiveSheet
icol = ColHeadCell.Column
'loop through values in selected column
For iRow = 2 To Fsheet.Cells(65536, icol).End(xlUp).Row
If Not SheetExists(CStr(Fsheet.Cells(iRow, icol).Value)) Then
Set Dsheet = Worksheets.Add(after:=Worksheets(Worksheets.Count))
Dsheet.Name = CStr(Fsheet.Cells(iRow, icol).Value)
Fsheet.Rows(1).Copy Destination:=Dsheet.Rows(1)
Else
Set Dsheet = Worksheets(CStr(Fsheet.Cells(iRow, icol).Value))
End If
Lrow = Dsheet.Cells(65536, icol).End(xlUp).Row
Fsheet.Rows(iRow).Copy Destination:=Dsheet.Rows(Lrow + 1)
Next iRow
End Sub
Function SheetExists(SheetId As Variant) As Boolean
' This function checks whether a sheet (can be a worksheet,
' chart sheet, dialog sheet, etc.) exists, and returns
' True if it exists, False otherwise. SheetId can be either
' a sheet name string or an integer number. For example:
' If SheetExists(3) Then Sheets(3).Delete
' deletes the third worksheet in the workbook, if it exists.
' Similarly,
' If SheetExists("Annual Budget") Then Sheets("Annual Budget").Delete
' deletes the sheet named "Annual Budget", if it exists.
Dim sh As Object
On Error GoTo NoSuch
Set sh = Sheets(SheetId)
SheetExists = True
Exit Function
NoSuch:
If Err = 9 Then SheetExists = False Else Stop
End Function
Change your Sub to:
Sub SplitToWorksheets_step4(SheetName as String)
and in the line:
Set Fsheet = ActiveSheet
to:
Set Fsheet = Worksheets(SheetName)
on a different page but this selects the active page, I want it to run
this macro on a specific sheet.
Well that is simple enough.
Set your Worksheet Object to a specific Sheet.Name - eg:
Dim Fsheet As Worksheet: Set Fsheet = Sheets("Your sheet name")
In a more practical usage, you could for example pass the sheet name as a procedure argument:
Private Sub SplitToWorksheets_step4(ByVal sheetName as String)
Dim fsheet as Worksheet: Set fsheet = Sheets(sheetName)
' ... do something
End Sub
Last but not least a practical way to apply a macro for every Worksheet:
Private Sub for_every_ws()
Dim ws as Worksheet
For Each ws In ThisWorkbook.Sheets
ws.Range("A1") = "I was here!" ' i.e.
Next ws
End Sub
So I have a pivottable and in column C there is field for which I am showing details for each record using this
For i=7 to 10
DATA.Range("C" & i).ShowDetail = True
Set wN = ThisWorkbook.Worksheets(1)
Next i
Now it works fine but the problem is Set wN = ThisWorkbook.Worksheets(1) assigns the wN the first worksheet but DATA.Range("C" & i).ShowDetail = True sometimes inserts the new worksheet which has the details at 1st or 2nd position. Now I want to know which was the new worksheet which was inserted and assign wN to it.
Do I have to make an array or list which keeps record of existing worksheets and then check which is the new one everytime? or there is an easy way to determine which is the newest worksheet in an workbook irrespective of the position.
Look at the Activesheet. ShowDetail creates the new sheet and activates it - so Set wn=ActiveSheet should work.
Sub Test()
Dim c As Range
Dim wrkSht As Worksheet
With ThisWorkbook.Worksheets("Sheet2").PivotTables(1)
For Each c In .DataBodyRange.Resize(, 1)
c.ShowDetail = True
Set wrkSht = ActiveSheet
Debug.Print wrkSht.Name
Next c
End With
End Sub
This link to Jon Peltiers page on Pivot Tables should be a massive help... https://peltiertech.com/referencing-pivot-table-ranges-in-vba/
The code shown does not add a worksheet, it sets wN to whatever sheet has index 1 (The second sheet created).
Try wN.Name = "C"& i & " field" to help figure out when each sheet is being created.
Open a new Workbook. Then run this code a few times:
Option Explicit
Public Sub TestMe()
Dim wsNew As Worksheet
Worksheets.Add After:=Worksheets(Worksheets.Count)
Set wsNew = Worksheets(Worksheets.Count)
Debug.Print wsNew.Name
End Sub
You would see, that wsNew is always the last one added. Thus with Worksheetes(Worksheets.Count) you may access it.
Edit:
If you want to know the name of the last added Worksheet, without adding After:, then use collection to remember all the worksheets you had before and simply compare them with the new collection. Run this code a few times:
Option Explicit
Public Sub TestMe()
Dim wsCollection As New Collection
Dim lngCounter As Long
Dim strName As String
Dim blnNameFound As Boolean
Dim ws As Worksheet
For Each ws In Worksheets
wsCollection.Add ws.Name
Next ws
Worksheets.Add
For Each ws In Worksheets
blnNameFound = False
For lngCounter = 1 To wsCollection.Count
If wsCollection.Item(lngCounter) = ws.Name Then
blnNameFound = True
End If
Next lngCounter
If Not blnNameFound Then Debug.Print ws.Name
Next ws
End Sub
The complexity is O².
I have a workbook with a master sheet for school report cards. I have a macro applied to a button for exporting information from the master sheet to separate, newly-generated sheets in the same workbook. A1:C71 is the template and goes to every new sheet, and the following columns of info, from D1:71 to Q1:71, each appear in separate sheets (always in D1:71).
Here's the screenshot (http://imgur.com/a/ZDOVb), and here's the code:
`Option Explicit
Sub parse_data()
Dim studsSht As Worksheet
Dim cell As Range
Dim stud As Variant
Set studsSht = Worksheets("Input")
With CreateObject("Scripting.Dictionary")
For Each cell In studsSht.Range("D7:Q7").SpecialCells(xlCellTypeConstants, xlTextValues)
.Item(cell.Value) = .Item(cell.Value) & cell.EntireColumn.Address(False, False) & ","
Next
For Each stud In .keys
Intersect(studsSht.UsedRange, studsSht.Range(Left(.Item(stud), Len(.Item(stud)) - 1))).Copy Destination:=GetSheet(CStr(stud)).Range("D1")
Next
End With
studsSht.Activate
End Sub
Function GetSheet(shtName As String) As Worksheet
On Error Resume Next
Set GetSheet = Worksheets(shtName)
If GetSheet Is Nothing Then
Set GetSheet = Sheets.Add(after:=Worksheets(Worksheets.Count))
GetSheet.Name = shtName
Sheets("Input").Range("A1:C71").Copy
GetSheet.Range("A1:D71").PasteSpecial xlAll
GetSheet.Range("A1:B71").EntireColumn.ColumnWidth = 17.57
GetSheet.Range("C1:C71").EntireColumn.ColumnWidth = 54.14
GetSheet.Range("D1:D71").EntireColumn.ColumnWidth = 22
End If
End Function`
I would now like to create a separate button to split the sheets into separate workbooks so that the master sheet can be kept for record keeping and the individual workbooks can be shared with parents online (without divulging the info of any kid to parents other than their own). I would like the workbooks to be saved with the existing name of the sheet, and wonder if there's a way to have the new workbooks automatically saved in the same folder as the original workbook without having to input a path name? (It does not share the same filename as any of the sheets).
I tried finding other code and modifying it, but I just get single blank workbooks and I need as many as have been generated (preferably full of data!), which varies depending on the class size. Here's the pathetic attempt:
`Sub split_Reports()
Dim splitPath As String
Dim w As Workbook
Dim ws As Worksheet
Dim i As Long, j As Long
Dim lastr As Long
Dim wbkName As String
Dim wksName As String
Set wsh = ThisWorkbook.Worksheets(1)
splitPath = "G:\splitWb\"
Set w = Workbooks.Add
For i = 1 To lastr
wbkName = ws
w.Worksheets.Add(After:=w.Worksheets(Worksheets.Count)).Name = ws
w.SaveAs splitPath
w.Close
Set w = Workbooks.Add
Next i
End Sub`
I have learned so much, and yet I know so little.
Maybe this will start you off, just some simple code to save each sheet as a new workbook. You would probably need some check that the sheet name is a valid file name.
Sub x()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
ws.Copy
ActiveWorkbook.Close SaveChanges:=True, Filename:=ws.Name & ".xlsx"
Next ws
End Sub
I feel like this is too simple to be stuck on, but I have a workbook with about 100 sheets, and I need to copy a range from one sheet (Sheet2 Range a1:H200) to Sheet5 AF1:AM200 and every sheet after (Sheet5 through Sheet100 or more). I have tried creating a loop and copying the original range and pasting to each sheet, but it hasn't worked. I feel like this is the closest I've gotten
Sub CopyPasteLoop()
Dim wsVar As Worksheet
For Each wsVar In ThisWorkbook.Sheets
With wsVar
ThisWorkbook.Worksheets("Sheet2").Range("A1:H200").Value = ThisWorkbook.Worksheets("Sheet5").Range("AF1").Value
End With
Next wsVar
End Sub
I feel like it should be simpler, but I can't make it work. Thanks!
Almost there. Try this:
Sub CopyPasteLoop()
Dim wsVar As Worksheet
Dim i as Integer
For i = 5 to ThisWorkbook.Worksheets.Count
ThisWorkbook.Worksheets(i).Range("AF1:AM200").Value = ThisWorkbook.Worksheets("Sheet2").Range("A1:H200").Value
Next i
End Sub
Or for better performance, use this:
Dim vRange as Variant
vRange = ThisWorkbook.Worksheets(2).range("A1:H200")
Dim i as Integer
For i = 5 to ThisWorkbook.Worksheets.Count
ThisWorkbook.Worksheets(i).Range("AF1:AM200").Value = vRange
Next i
Hopefully #Scott Holtzman's answer will work for you (providing your sheets are indexed in the same order as they're named). This approach will also work.
Dim wb As Workbook, ws As Worksheet
Dim rng As Range
Set wb = ThisWorkbook
Set rng = wb.Sheets("Sheet2").Range("A1:H200")
For Each ws In wb.Sheets
If CInt(Right(ws.Name, Len(ws.Name) - Len("Sheet"))) >= 5 Then
ws.Range("AF1:AM200").Value = rng.Value
End If
Next ws