Posts by Mumps

    Re: Copy and paste rows based on multiple criteria


    My apologies. The problem was caused by a typo. I have fixed the code tag. Thank you so much for you suggestion, AAE. I modified your code as below and ran through it one line at a time. It worked as expected except that it didn't copy the rows to the RegionQualifiers sheet. I'm not sure what went wrong.


    [VB]
    Option Explicit

    Sub Copy_Cells()

    Dim nextrow As Long, lastrow As Long
    Dim rngData As Range

    Application.ScreenUpdating = False
    Sheets("TrackA").Unprotect

    nextrow = Sheets("RegionQualifiers").Cells(Rows.count, "A").End(xlUp).Row + 1

    With Sheets("TrackA")
    .AutoFilterMode = False
    lastrow = .Cells(Rows.count, 1).End(xlUp).Row

    .Range("H1") = "Helper"
    .Range("H2:H" & lastrow).Formula = "=OR(LEFT(A2,FIND("" "",A2,1)-1)={""800M"",""1500M"",""Relay""})"

    Set rngData = .Range("A1:H" & lastrow)

    rngData.AutoFilter field:=3, Criteria1:=">=1", Operator:=xlAnd, Criteria2:="<=3"
    rngData.AutoFilter field:=8, Criteria1:=False

    rngData.Resize(, 7).SpecialCells(xlCellTypeVisible).Copy Sheets("RegionQualifiers").Range("A" & nextrow)

    Application.CutCopyMode = False

    .AutoFilterMode = False

    .Range("H1:H" & lastrow).Clear

    End With

    Set rngData = Nothing

    Application.ScreenUpdating = True

    End Sub
    [/VB]

    I want to copy rows from sheet "TrackA" to sheet "RegionQualifiers" based on certain criteria. The rows should be copied below each other on the next empty line. I have written the following code and it works fine. It copies the rows only if the value in Column C = 1, 2 or 3 which is what I want. However, at the same time, I want to exclude the rows where Column A contains the strings "800M" or "1500M" or "RELAY". I have tried different things but I can't get it to work properly. I have attached a sample file. Any help would be greatly appreciated.


    [VB]
    Sheets("TrackA").Activate

    Dim bottomC As Long
    bottomC = Range("c" & Rows.count).End(xlUp).Row
    Dim cell As Range
    For Each cell In Range("C2:C" & bottomC)
    If cell.Value = 1 Or cell.Value = 2 Or cell.Value = 3 Then
    cell.EntireRow.Copy Sheets("RegionQualifiers").Cells(r, 1)
    r = r + 1
    End If
    Next cell
    [/VB]

    Re: Keep buttons visible on screen when scrolling up/down.


    Thank you so much for you suggestion. I would like to keep the layout of the page where the buttons are underneath each other and then underneath the buttons is the text box. Given this layout, it would make it awkward to put everything in the first row. Is there any other way, possibly with VBA code?

    I have two buttons that run macros on a worksheet and a text box with instructions. They are placed at the top of the sheet. I would like the buttons and text box to remain visible when I scroll up or down. At present, they disappear when I scroll down. Any suggestions as to how I can keep them visible using VBA code would be appreciated.

    I have the following code which looks for a variable and if it doesn't find it, displays the messagebox. If it does find it, the line it is on is deleted. There is one problem. All the cells in Range("b2:b" & bottomB) have strings that begin with a capital letter. If the InputBox variable is typed correctly but without the captal letters, no error is generated and the MsgBox does not appear but the appropriate line is not deleted. How can I change my code so that the Match statement is not case sensitive? Thank you in advance for any suggetsions.


    [VB]
    schoolname = InputBox("Enter the name of the school you wish to delete.", "Delete School")

    Dim bottomB As Long
    bottomB = Range("b" & Rows.count).End(xlUp).Row
    Dim x As Variant
    x = Application.Match(schoolname, Range("b2:b" & bottomB), 0)
    If IsError(x) Then
    Application.Cursor = xlDefault
    MsgBox ("The school you entered was not found. Make sure that your enter the name exactly as it appears in Column B, including capitalization, punctuation and spacing. Please try again.")
    Exit Sub
    End If

    Application.Cursor = xlWait
    Dim i As Integer
    For i = bottomB To 2 Step -1
    If Range("B" & i) = schoolname Then
    Application.ScreenUpdating = True
    Application.Cursor = xlDefault
    Rows(i).Delete
    Application.ScreenUpdating = False
    Application.Cursor = xlWait
    MsgBox (schoolname & " has been deleted.")
    End If
    Next i


    [/VB]

    Would anyone have any suggestions as to how I could use the Speak method to say the name of a sheet when I click on its tab? I tried entering the following line of code in the sheet code for Sheet1, but it didn't work. Thank you.


    [VB]
    Application.Speech.Speak "Sheet1"
    [/VB]

    Re: If Elseif within For Next loop.


    Many thanks to jindon and yegarboy. This is the code I have now. When I run it, I get 'Method Range of object_Global failed' error and x=Application...... line is highlighted. I only want to exit the sub if no match is found. If a match is found, I want to delete the row and continue execution of the rest of the macro since this is only a part of a larger macro.


    [VB]
    schoolname = InputBox("Enter the name of the school you wish to delete.", "Delete School")


    Dim bottomB As Integer
    bottomB = Range("b" & Rows.count).End(xlUp).Row
    Dim x As Variant
    x = Application.Match(schoolname, Range("b2:b" & bottomB, 0))
    If IsError(x) Then
    MsgBox "No match found"
    Exit Sub
    End If


    Dim i As Integer
    For i = 2 To bottomB
    If Range("B" & i) = schoolname Then
    Rows(i).Delete
    End If
    Next i
    [/VB]

    I have the following code that I can't get to work properly. The code skips the "If" line and goes to the "Elseif" line even if the variable 'schoolname ' is found. If schoolname is found, I want that particular row deleted. If it isn't found, I want the message displayed and then I want to stop sub execution. Any suggestions would be appreciated.


    [VB]
    schoolname = InputBox("Enter the name of the school you wish to delete.", "Delete School")

    Dim bottomB As Long
    bottomB = Range("b" & Rows.count).End(xlUp).Row
    Dim i As Integer
    For i = 2 To bottomB
    If Range("B" & i) = schoolname Then
    Rows(i).Delete
    ElseIf Range("B" & i) <> schoolname Then
    MsgBox ("The name you entered was not found. Please try again.")
    Exit Sub
    End If
    Next i
    [/VB]

    Re: Method 'On Time' of object'_Application failed


    After a little trial and error, I found the cause of the error. It is not enough to 'Enable all Macros' and 'Trust access to VBA project object model' in Excel's Macro Security, you must also disable Protected View. When I did all these things, everything worked perfectly. Just remember to re-set the security settings back to what they were afterwards to maximize protection.

    I have this code as part of ThisWorkbook to open a flashscreen when the file is opened.


    [VB]
    Private Sub Workbook_Open()
    UserForm1.Show
    End Sub
    [/VB]


    The UserForm1 has the following code attached to call the "KillTheForm" routine so that the form disappears after 7 seconds:


    [VB]
    Private Sub UserForm_Activate()
    Application.OnTime Now + TimeValue("00:00:07"), "KillTheForm"
    End Sub
    [/VB]


    This is the "KillTheForm" code:


    [VB]
    Private Sub KillTheForm()
    Unload UserForm1
    End Sub
    [/VB]


    The code works properly on my machine but when I emailed the workbook to a friend, he got Error 1004 ... Method 'On Time' of object'_Application failed. When he opened the file directly from the email, the splash screen appeared and then disappeared as it should after 7 seconds. However, when he clicked the ENABLE EDITING button in Excel 2010, he got the error message. After clicking END in the error screen, the macros in the workbook worked as they should and everything worked properly. If he saves the file, the error occurs when the file is opened the first time only. If he then closes it and opens it a second time, the ENABLE EDITING BUTTON DOESN'T APPEAR and neither does the error. Suggestions would be greatly appreciated.

    Re: Replace Computer Name with generic name


    Hello again:


    I tried the code in both Windows XP and in Windows 7. In both cases, the files were not saved on the desktop but in My Documents folder in Windows 7 and in a subfolder of Documents and Settings in Windows XP. Strangely, the code worked in XP if I didn't include the following lines:


    [VB]
    Dim DesktopAddress As String
    DesktopAddress = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    [/VB]


    Any suggestions? I would like the code to work in both versions of Windows if possible.

    Re: Replace Computer Name with generic name


    Thank you so much, gentlemen. Unfortunately, I have an appointment to go to so I will try out your suggestions when I return and let you know how they worked out.


    Hi cytop. I'm not exactly sure of the contex of environ("username") in the SaveAs line. Could I ask you to clarify for me? Many thanks.

    I've written the following code to save a file to my Desktop in Windows 7. I would like to have this code work on any machine. However, because the computer name (in my case it is Mumps) is specific for every machine, this code would not work on somebody else's computer. Is there any way that I can change the computer name so that this code will run on any machine in both Windows XP and Windows 7? Any help would be greatly appreciated.


    [VB]
    regionname = InputBox("Enter the name of the Region.", "Region Name: North, South, East, West")
    meetdate = InputBox("Enter the date of the Meet.", "Date of Meet")
    ChDir "C:\Users\Mumps\Desktop"
    ActiveWorkbook.SaveAs Filename:="C:\Users\Mumps\Desktop\" & regionname & "Division" & meetdate & "Backup" & ".xlsm"
    MsgBox ("The file has been saved on your Desktop with the following name: " & regionname & "Division" & meetdate & "Backup" & ".xlsm"
    [/VB]