Re: Delete Sheet Whose Name Is Defined By A Cell Value
Thankyou very much Dave, that works perfectly!
Re: Delete Sheet Whose Name Is Defined By A Cell Value
Thankyou very much Dave, that works perfectly!
Re: Delete Sheet Whose Name Is Defined By A Cell Value
Hi Dave,
Thanks for the quick response.
I have adapted the code to become:
But it gives me a Run-Time 13 mismatch error.
Other combinations where I tried referring to the 'StudentIndex' sheet by its number, 2, gave me a Run-Time 9 error.
The sheet I am referring to has a comma in its name since it the name of student written in the form 'LAST NAME, First Name) taken from my school's central system. Could this be upsetting it?
Incidentally when I run the error catching code, the name of the sheet I want to delete does appear in the error box.
Any further help you could give would be very welcome.
Thanks,
Jon
Hi,
I was wondering if anyone could help with the following problem.
I have a workbook containing a sheet named 'StudentIndex' in which is a table containing the headings 'Student Name' and 'Link'. Clicking on the the link next to a student's name directs me to a seperate sheet within the same workbook, named with that student's name.
I am writing a macro to delete students from the workbook. I can delete their details from the 'StudentIndex' sheet but what I can't do is then delete the worksheet that has their name.
I guess what I need to do is either define a worksheet, say'wsX', with a dynamic name determined by a cell somewhere in the 'StudentIndex' sheet and then simply delete the sheet OR follow the hyperlink to the student's worksheet and then just delete the active sheet. However being a bit of an eegit I don't know how to either of those things.
Any help you could give would be greatly appreciated.
Thanks,
Jon
Re: Prevent Editing And Selecting Of Range In Newly Created Workbook
That's exactly what I was after. Thanks, your help is greatly appreciated.
FYI, the final version of the code was:
Private Sub CreateNewSheets_Click()
'Thanks to Ger Plante at www.Ozgrid.com for his invaluable help in getting this loop function to work
Application.ScreenUpdating = False
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Sheets("Template")
Dim ws2 As Worksheet
Set ws2 = ThisWorkbook.Sheets("RawData")
Dim ws5 As Worksheet
Set ws5 = ThisWorkbook.Worksheets("lookups")
Dim Rng1 As Range
Dim varPath As Variant
Dim lLoop As Long
Set Rng1 = ws1.Range("A1:B505")
varPath = ThisWorkbook.Path
Dim Cell As Range
'Checking that no duplicate sheets are to be made
If ws2.Range("E508") > 0 Then
iResponse = MsgBox("One or more of the files you are trying to create already exists - the 'x's with a red background represent ones that already exist. If you continue you will overwrite one or more student files and risk losing their data. Do you want to exit this routine?" & vbNewLine & vbNewLine & "Click YES if you wish to exit and then clear the red 'x's before trying again" & vbNewLine & vbNewLine & "Click NO if you wish to continue anyway", vbYesNo, "WARNING: Creating new files may destroy others")
If iResponse = vbNo Then
GoTo 1
Else: Exit Sub
End If
Else
GoTo 1
End If
1
'Replace "X" with "x"
ws2.Range("F1:IU1").Select
Selection.Replace What:="X", Replacement:="x", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True
'Create new sheets
For lLoop = 2 To 251 'first row of data to last row.
If ws1.Cells(lLoop, 4).Value = "x" Then '4 = Column D
ws1.Activate
ws1.Range("e" & lLoop & ":g" & lLoop).Copy
ws1.Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Rng1.Copy
Workbooks.Add
ActiveSheet.Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveSheet.Range("A1").Select
ActiveSheet.SaveAs varPath & "\Student Data Files\" & ActiveSheet.Range("B1") & ".xls"
Cells.Locked = False
Range("B1:B504").Locked = True
ActiveSheet.EnableSelection = xlUnlockedCells
ActiveSheet.Protect ("S4Lfun")
ActiveWorkbook.Close True
Else
End If
Next lLoop
'Update file list
ws5.Range("e2:e501").ClearContents
Dim fs As FileSearch, ws As Worksheet, i As Long
Set fs = Application.FileSearch
varPath = ThisWorkbook.Path
'Get file list and print it to lookups, A2
With fs
.SearchSubFolders = False ' set to true if you want sub-folders included
.FileType = msoFileTypeAllFiles 'can modify to just Excel files eg with msoFileTypeExcelWorkbooks
.LookIn = varPath & "\Student Data Files" 'modify this to where you want to serach
If .Execute > 0 Then
Dim rng As Range
Set rng = ws5.Range("e2")
For i = 1 To .FoundFiles.Count
rng.Cells(i, 1) = Mid$(.FoundFiles(i), InStrRev(.FoundFiles(i), "\") + 1)
Next
Else
MsgBox "No files found"
End If
End With
ws2.Activate
ws2.Range("A1").Select
ws2.Activate
ws2.Range("f1:iu1").ClearContents
ws2.Range("A1").Select
Application.ScreenUpdating = True
MsgBox ("New files created!")
End Sub
Display More
Re: Prevent Editting And Selecting Of Range In Newly Created Workbook
Hi Daniel,
Thanks for your help.
This does lock the cells I want but doesn't stop me selecting or editting them.
Any ideas?
Jon
Hi All,
I have the following code that Ger Plante very kindly helped me with which, depending on whether there is an 'x' by someone's name in a list, creates a new workbook, copies some information to it and saves it before moving on to the next 'x'.
http://www.ozgrid.com/forum/showthread.php?t=103272
For lLoop = 2 To 251 'first row of data to last row.
If ws1.Cells(lLoop, 4).Value = "x" Then '4 = Column D
ws1.Activate
ws1.Range("e" & lLoop & ":g" & lLoop).Copy
ws1.Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Rng1.Copy
Workbooks.Add
ActiveSheet.Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveSheet.Range("A1").Select
ActiveSheet.SaveAs varPath & "\Student Data Files\" & ActiveSheet.Range("B1") & ".xls"
ActiveWorkbook.Close
Else
End If
Next lLoop
Display More
Could anyone please tell me how I can modify the code such that any cells in the range "b1:b504" in Sheet1 of the the new workbook can't be selected or edited without a password....I have tried unsuccessfully using Protect but am not sure how to get vba to set it to specific cells and determine exactly what is allowed in those cells.
Thanks,
Jon
Re: Loop Through Rows and Copy Data
That is awesome thanks Ger...it works perfectly. My apologies, I should have made it clearer, I know next to nothing about vba I am just good at adapting what I find on Ozgrid but this time there was nothing quite close enough and internet tutorials were not clear enough. Anyway, thanks again, and have a good evening,
Jon
PS. I will reference you in the code so that anyone checking it knows where it came from
Re: Loop Through Rows and Copy Data
What I need is, depending on whether a student has an "x" by his/her name to copy some data about them into a range containing a load of assessment statements and then copy this range into new workbook with an appropriate name.
What I have written will do this for the first student but not the other 249.
What Ger has written checks whether the x is there but then only copies over the data from the first row.
So in short Yes...ish.
Re: Create Workbooks From List And Import Data
Thanks Ger.
I have done as you suggested but it seems to always copy the data from e2:g2.
What I need it do is when it checks the 'x' in for example D4 to then copy the data from E4:G4 and so on
Any ideas?
Hi,
I have some data for my students in the range D2:G251, where each row is a different student.
I need to write a macro that, if there is an 'x' against their name in column D, will copy the data in columns E-G into range A1:B500 and copy that range into a new workbook and save the workbook with the students name.
The following code does this for the first row, but I don't know how to write a loop (or whatever) to make it do it for the other 249 rows.
Private Sub CreateNewSheets_Click()
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Sheets("Template")
Dim Rng1 As Range
Set Rng1 = ws1.Range("A1:B504")
varPath = ThisWorkbook.Path
If ws1.Range("D2") = "x" Then
ws1.Activate
ws1.Range("e2:g2").Copy
ws1.Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Rng1.Copy
Workbooks.Add
ActiveSheet.Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveSheet.SaveAs varPath & "\Student Data Files\" & ActiveSheet.Range("B1") & ".xls"
ActiveWorkbook.Close
Else
End If
End Sub
Display More
Any help you could give would be greatly appreciated.
Thanks,
Jon
Re: Automatically Fit Row Height
Hi Ger,
Thanks for all your help. I had another workbook open which seems to have been interfering with it. I closed that workbook and now it's fine. Not really sure as there was no code in the other workbook but so long as it works I don't care.
Thanks again for your time and have a good day,
Jon
Re: Automatically Fit Row Height
Hi,
Yes it's the line with the AutoFit that brings up the error. Frustrating as I've used it before and it was fine.
I have tried all three of your suggestions but to no avail. Would hidden cells affect it?
Thanks,
Jon
Hi,
I have a spreadsheet that will help my students to assess how good they are at various tasks. They choose an option and it gives them a series of statements to match themselves against. Because these statements are of widely different sizes I want to automatically adjust the rows from 6 to 56 to the right height so there isn't too much wasted space.
I have been trying to use the code
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Assessment Tool")
ws1.Activate
ws1.Rows("6:55").EntireRow.AutoFit
However I always get the error: "AutoFit method of range class failed". I have tried as many ways as I can think of to define the rows that need AutoFit-ing and nothing seems to work. I have searched both Ozgrid and more widely and couldn't find a specific enough case to learn from.
The code is part of a larger macro (see below) run from a button and everything else works fine (although I'm sure it's probably not very efficient!). Any help you could give me would be great.
Thanks,
Jon
The whole macro:
Private Sub GetLevels_Click()
Application.ScreenUpdating = False
Range("C1").Select
Selection.Copy
Range("Y2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("C3").Select
Selection.Copy
Range("Y3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("N6:N55").Select
Selection.Copy
Range("I6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("D6:D55").ClearContents
Range("R6:R55").Select
Selection.Copy
Range("D6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Dim ws3 As Worksheet
Set ws3 = ThisWorkbook.Worksheets("AssessmentStatements")
ws3.Activate
ws3.Range("f2:g251").Select
Selection.Copy
ws3.Range("h2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ws3.Range("h2:h251").Select
Selection.Replace What:="I1", Replacement:= _
"I"
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Assessment Tool")
ws1.Activate
ws1.Rows("6:55").EntireRow.AutoFit
Application.ScreenUpdating = True
Range("C1").Select
End Sub
Display More
Re: Count Number Of Formulas In Range
Great thanks Andy, I'll give it a whirl.
Hi,
For various reasons I need to copy a the range "a2:s251" in the sheet "FWD Input" to another sheet but I need to remove any formulas.
To do this I have used the code:
This works fine if there are formulas in that range, however if there aren't it gives me: " Run time error: 1004 No cells were found"
So I think I need some code that counts the number of cells in the range with formulae in them and either goes ahead if there are some or quits if there aren't.
Any help you can give would be greatly appreciated
Thanks,
Jon
Re: Autosize Row Height
Thanks darkyam.
For some reason it doesn't work yet when I manually autosize them its fine.
Is this because it Excel won't yet have calculated the contents of the cells when the macro tries to resize them?
If so, is it possible to build in a delay before doing the resize?
Hi,
I have a spreadsheet in which double clicking on any of the cells in the range A4:C17 changes the contents of cells F4:I33. The following code tells me which is the active cell and then pulls the values for F4:I33 from a lookup table based in this.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Range("B100") = ActiveCell.Address()
Cancel = True
End Sub
Could anyone please help me out with a snippet of code to stick in this (probably after the third line) that autosizes rows 4 to 33. There are no merged cells involved.
Thanks,
Jon
Re: Prevent Cell Change Depending On Sum Result
Thanks Dave, it works perfectly now!
Hi,
Sorry I tried searching but to no avail.
In my spreadsheet cell g1 is a name and cells g3:g6 contain data for that name.
I have a macro that exports the data in g3:g6 to another workbook and then deletes it.
What I need is a macro that when I try to change g1, gives me a warning if there is unexported data in cells g3:g6 (ie the sum of them is greater than zero) and gives the option of either continuing or stopping (presumably using a YesNo box).
Any help you could give me would be very welcome
Thanks,
Jon
PS. I am a VBA newbie
Re: Print Range Specified By A Cell
Hi,
I am somewhat more alert in the morning and have found this link (despite ages searching yesterday):
http://www.ozgrid.com/forum/showthread.php?t=53491
Following the advice in it I have set the Print_Area (Insert > Name > Define Name > Print_Area) to the following:
=INDIRECT(CONCATENATE("Browser!$E$2:I",MAX(Browser!$E$4:$E$33)+3))
Where Browser! is my worksheet and the concatenate function is what I was using to define my range.
Its ugly but it works.
Thanks for your help,
Jon