Re: Loop through visible rows only.
Thank you so much for the terrific example. It was very easy to follow and adapt to my code. Now it works properly.
Re: Loop through visible rows only.
Thank you so much for the terrific example. It was very easy to follow and adapt to my code. Now it works properly.
Re: Loop through visible rows only.
Thank you for your suggestion. I had actually read this page and many others on the topic. I have tried several approaches but I can't get it to work. If it's possible and not too much trouble, I was hoping for an example of some code using the information in my original posting. Many thanks.
I am trying to perform certain tasks using only the rows that are visible after a sheet is filtered. I am able to get the row number of the first and last visible rows but the row numbers are not consecutive. For example: I could have 3 visible rows with row numbers 8, 123, 248 respectively. If I use a For...Next loop (FirstRow to LstRow - in my example: 8 to 248), will this loop also include all the hidden rows in between these number? If the hidden rows are included in the loop, how can I limit what I am trying to do, to only those three rows (8, 123, 248)? Any help would be greatly appreciated.
Re: Subscript out of range
Wow! That's fantatstic. It certainly saves me a lot of time and will make my code much more efficient. Thank you once again for all your help.
Re: Subscript out of range
That is great advice. I'll want to check for reserved characters and also for string length. You have made my life so much easier. This was a task my wife assigned to me.
Re: Subscript out of range
Gentlemen...Thank you so much for all your efforts. After a more detailed examination of the data, I found two cells that used the '/' character which of course is a "NO-NO". The code now works the way I wanted it to. You went above and beyond with your help. It is so much appreciated. Here is the code:
[VB]
Application.DisplayAlerts = False
Sheets("2011-2012 ProgramsMaster").Select
Dim ProgramCode As String
Dim cell As Range
For Each cell In Sheets("2011-2012 ProgramsMaster").Range("T2:T147")
If cell.Value <> "" Then
ProgramCode = cell.Offset(0, 1)
On Error Resume Next
Worksheets(ProgramCode).Delete
On Error GoTo 0
Worksheets("ElementaryBlank").Copy after:=Sheets(Sheets.count)
ActiveSheet.Name = ProgramCode
End If
Next cell
Application.DisplayAlerts = True
[/VB]
Re: Subscript out of range
My apologies. I removed most of the columns in my working file so now columns A and B subsitute for T and U in the attached file. What I basically want to do is delete exisiting sheets with a name that corresponds to the value of 'ProgramCode' and then re-create them with the same name. Since there will be duplicates for the value of 'ProgramCode', I want a the sheet created with that name only the first time it is encountered and ignore each subsequent time it is found. I've taken out all the rows with blank cells in column U (in this case column B).
Re: Subscript out of range
I have attached a sample file.
Re: Subscript out of range
This what the code looks like now. I put a period to the left of EntireColumn. I'm still getting the same error on the same line.
[VB]
Application.DisplayAlerts = False
Sheets("2011-2012 ProgramsMaster").Select
Dim ProgramCode As String
Dim cell As Range
For Each cell In Sheets("2011-2012 ProgramsMaster").Range("T2:T147")
If cell.Value <> "" Then
If Application.Match(cell.Offset(0, 1).Value, cell.Offset(0, 1).EntireColumn, 0) = cell.Row Then
ProgramCode = cell.Offset(0, 1)
On Error Resume Next
Worksheets(ProgramCode).Delete
On Error GoTo 0
Worksheets("ElementaryBlank").Copy after:=Sheets(Sheets.count)
ActiveSheet.Name = ProgramCode
End If
End If
Next cell
Application.DisplayAlerts = True
Re: Subscript out of range
Your quick reply is very much appreciated. When I ran your code, I got the same error message on the line:
[VB]
ActiveSheet.Name = ProgramCode
[/VB]
Re: Subscript out of range
Thank you so much Roy and Mike. When I ran Mike's code, I got an error: Run-time error '1004': You typed an invalid name for a sheet or chart .... I believe (but I'm not sure) that this is happening because when going through the 'For Each' loop, the value of 'ProgramCode' is found more than once. The first time it is found, the sheet 'ElementaryBlank' is copied correctly and the sheet name is changed to the value of 'ProgramCode which is what I want, but the second and subsequent times it is found, the error is generated. A copy of the sheet is made but with the name 'ElementaryBlank(1)'. I would like the code to skip or ignore the 'Copy' command if 'ProgramCode' is found more than once. I have attached a sample file. Thank you once again.
[VB]
Application.DisplayAlerts = False
Sheets("2011-2012 ProgramsMaster").Select
Dim ProgramCode As String
Dim cell As Range
For Each cell In Sheets("2011-2012 ProgramsMaster").Range("A2:A147")
If cell.Value <> "" Then
ProgramCode = cell.Offset(0, 1)
On Error Resume Next
Worksheets(ProgramCode).Delete
On Error GoTo 0
Worksheets("ElementaryBlank").Copy after:=Sheets(Sheets.count)
ActiveSheet.Name = ProgramCode
End If
Next cell
Application.DisplayAlerts = True
[/VB]
Re: Subscript out of range
I may not have been clear on what is returned. ProgramCode returns the string value in Cell2.Offset(0,1)
Re: Subscript out of range
It returns the variable from the line:
[VB]
ProgramCode = cell2.Offset(0, 1)
[/VB]
I have written the following code to delete certain sheets if they exist and to copy and rename another sheet if it doesn't exist. The first 'For Each' section deletes the sheet based on the value of the variable 'ProgramCode' and it works fine. I would like the second 'For Each' section to copy and rename a sheet only if it doesn't already exist. When I run the macro, I get the error on the line.[VB]If Worksheets(ProgramCode) Is Nothing Then[/VB] Any help would be greatly appreciated.
[VB]
Sheets("2011-2012 ProgramsMaster").Select
Dim ws As Worksheet
Dim ProgramCode As String
Dim cell As Range
Dim cell2 As Range
Dim count As Integer
count = 1
For Each cell In Range("T2:T10")
If cell.Value <> "" Then
ProgramCode = cell.Offset(0, 1)
Application.DisplayAlerts = False
For Each ws In Worksheets
If ws.Name = ProgramCode Then
ws.Delete
End If
Next ws
Application.DisplayAlerts = True
End If
Next cell
For Each cell2 In Range("T2:T10")
If cell2.Value <> "" Then
ProgramCode = cell2.Offset(0, 1)
For Each ws In Worksheets
If Worksheets(ProgramCode) Is Nothing Then
Worksheets("ElementaryBlank").Copy after:=Sheets(Sheets.count)
ActiveSheet.Name = ProgramCode
count = count + 1
End If
Next ws
End If
Next cell2
[/VB]
Re: Execute multiple macros on selected sheets
Sorry. Forgot 'End With" line.
[VB]
Dim myArray (1 to 4) as String
myArray(1) = "x"
myArray(2) = "y"
myArray(3) = "z"
myArray(4) = "v"
Dim itm As Variant
For each itm in myArray
With Sheets(itm)
Call Fill
Call Copy
Call Sum
End With
Next itm
[/VB]
Re: Execute multiple macros on selected sheets
Try:
[VB]
Dim myArray(1 To 4) As String
myArray(1) = "x"
myArray(2) = "y"
myArray(3) = "z"
myArray(4) = "v"
Dim itm As Variant
For Each itm In myArray
With Sheets(itm)
Call Fill
Call Copy
Call Sum
Next itm
[/VB]
Re: Concatenate asterisk (VBA)
Try:
[VB]
Dim name As String
name = "*" & "John" & "*"
[/VB]
Re: Range() using two variables.
Try:
[VB]
ActiveSheet.Range("D" & x, "F" & x)
[/VB]
Re: Check if value exists in row - if so - return row and column headings w/value
entrailnu:
Try the following code. Change the sheet names in the code to match the names that you have used. If you add more columns and/or more rows, the code will automatically adjust to pick them up.
[VB]
Sub FindValues()
Sheets("sheet1").Activate
Dim LastColLetter As String
Dim LastColumn As Integer
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Columns.
LastColumn = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
LastColLetter = Replace(Cells(1, LastColumn).address(False, False), "1", "")
End If
Dim bottomA As Integer
bottomA = Range("a" & Rows.Count).End(xlUp).Row
Dim cell As Range
Dim x As Integer
Dim c As Integer
Dim r As Integer
x = 1
For r = 2 To bottomA
c = 2
For Each cell In Range("B" & r, LastColLetter & r)
If cell.Value <> 0 Then
c = c + 1
cell.Copy Sheet2.Cells(x, c)
Range("A" & cell.Row).Copy Sheet2.Cells(x, 1)
Cells(1, cell.Column).Copy Sheet2.Cells(x, 2)
End If
Next cell
x = x + 1
Next r
End Sub
[/VB]