Posts by Mumps

    I've written this code to copy and paste a cell based on certain criteria. It works very well. However, instead of copying and pasting one cell, in this case Range("C" & b), I want to copy and paste Range("B" & b) and Range("C" & b) concatenated. The first range contains a first name and the second range contains a surname. I want the full name to appear in one cell in Column Q. I've tried everything but I can't seem to get anywhere. Any help would be great!


    [VB]
    'Finds birdie hole generated by random number.
    Dim lCount As Long
    Dim BirdieHole As Range
    Set BirdieHole = Range("E4")
    For lCount = 1 To WorksheetFunction.CountIf(Rows(4), RandNum)
    Set BirdieHole = Rows(4).Find(What:=RandNum, After:=BirdieHole, _
    LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
    SearchDirection:=xlNext, MatchCase:=False)
    If BirdieHole = RandNum Then Exit For
    Next lCount

    Dim BirdieHoleCell As Range
    Set BirdieHoleCell = Cells(5, BirdieHole.Column)
    Dim bottomQ As Long
    bottomQ = Range("q" & Rows.Count).End(xlUp).Row
    Range("Q23" & ":Q" & bottomQ).Delete
    Dim b As Integer
    For b = 7 To bottomQ
    Dim Par As Integer
    Par = Right(BirdieHoleCell, 1)
    If Cells(b, BirdieHole.Column).Value < Par Then
    Range("C" & b).Copy _
    Destination:=Range("Q65536").End(xlUp).Offset(1, 0)
    End If
    Next b
    [/VB]

    Re: Find cell row number based on cell value.


    Your question highlighted my mistake. I can't believe that I missed it! The i should have been an r. Here is the code that works. Thanks for leading me to the solution.


    [VB]
    Dim Flight1End As Integer
    Flight1End = Fix(Range("a" & Rows.Count).End(xlUp).Value / 2)

    Dim bottomA As Long
    bottomA = Range("a" & Rows.Count).End(xlUp).Row
    Dim RowFlight1End As Integer
    Dim r As Integer
    For r = bottomA To 7 Step -1
    If Range("A" & r) = Flight1End Then
    RowFlight1End = Range("A" & r).Row
    If Range("A" & r) = Flight1End Then Exit For
    End If
    Next r
    [/VB]

    I have written this code to find the row number of a cell based on its value. In this case, Flight1End is correctly calculated as 33. BottomA is correctly found as 73. The MsgBox gives a value of 6 when it should be returning a value of 39. I can't seem to find the problem. Any suggestion would be greatly appreciated.


    [VB]
    'Calculates end of Flight 1, rounding down if number of players is uneven.
    Dim Flight1End As Integer
    Flight1End = Fix(Range("a" & Rows.Count).End(xlUp).Value / 2)


    Dim bottomA As Long
    bottomA = Range("a" & Rows.Count).End(xlUp).Row
    Dim RowFlight1End As Integer
    Dim r As Long
    For r = bottomA To 7 Step -1
    If Range("A" & r) = Flight1End Then
    RowFlight1End = Range("A" & i).Row
    End If
    Next r
    MsgBox (RowFlight1End)
    [/VB]

    I have created a button on a worksheet by inserting a rounded rectangle from the Shapes menu and then assigned a macro to it. I want to make this button invisible by default when the workbook is opened. I then want to make it visible when another macro is run. The name of the shape is "Rounded Rectangle 3". I believe that I can make the button visible/invisible by setting the property to true or false using code ... for example 'ActiveSheet.Shapes.Range(Array("Rounded Rectangle 3")).Visible = False' but how can I make it invisible by default on opening the workbook? Your help would be greatly appreciated.

    I am trying to write some code to delete an entire row if the cells in columns A, B and C are empty. When I try the code, I get the error message "Delete method of range class failed." Any suggestions would be appreciated.


    [VB]
    Dim bottomE As Long
    bottomE = Range("e" & Rows.count).End(xlUp).Row
    Dim i As Long
    For i = bottomE To 4 Step -1
    With Range("A4:E123")
    If .Range("A" & i) = "" And .Range("B" & i) = "" And .Range("C" & i) = "" Then .EntireRow.Delete
    End With
    Next i
    [/VB]

    Re: Method Range of object Global failed


    I managed to find a solution by inserting the formula into F5 if it was empty. This is what that section of code now looks like. I couldn't have done it without your help in finding the problem in the first place. Many thanks.


    [VB]
    'Copies formula in F5 down in Column F eqal to #rows in Column E
    bottomE = Range("e" & Rows.count).End(xlUp).Row
    Range("F5").Select
    If Range("F5") = "" Then Range("F5").FormulaR1C1 = _
    "=IF(((AND((RC[-5]=""""),(RC[-4]=""""),(RC[-3]="""")))),"""",IF((AND(RC[-5]<>"""",RC[-4]=R[-1]C[-4])),R[-1]C+1,IF (RC[-5]="""",R[-1]C,1)))"
    Range("f5:f" & bottomE).FillDown
    [/VB]

    I have written a lengthy macro which I run on 12 sheets and it works perfectly for all sheets except one. The sheets are identical in format, same number of columns, same column headers. The number of rows varies from one sheet to another. I cannot figure out why I get the error message on only one of the sheets. I have included an attachment with most of the sheets deleted but the macro included. If you run the macro with the Boys8 sheet active, it will run properly as it does on all the sheets that aren't in the attached file. If you run the macro with the Girls8 sheet active, you get the error message. I was hoping that someone might have some suggestions as to what might cause this to happen and what I could look for. Any suggestions would be of great help.

    I am using a loop to look for a range of cells based on certain criteria and then trying to copy that range to the first visible empty cell in Column H starting at cell H4. Each time the routine goes through the loop, it should paste the found range to the next visible and empty cell below. I am using the following code but I am missing the part that finds the first visible cell below H4. Any suggestions would be greatly appreciated.


    [VB]
    'Copies Teams to Team data range.
    Dim bottomF As Long
    bottomF = Range("f" & Rows.count).End(xlUp).Row
    For r = 3 To bottomF
    Set FirstCell = Range("C" & r)
    Set LastCell = Range("F" & r)
    If FirstCell Like "*Total*" And LastCell > 2 Then
    Range(FirstCell, LastCell).Copy
    ActiveSheet.Range("H1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    End If
    Next
    [/VB]

    Re: Copy cell value only with no formatting to destination.


    Thank you for your suggestion. I actually tried the same thing but for some reason instead of copying only two rows and adding it to what is already on the sheet, it repeatedly copies the rows specified by the code directly before it to the 2000th row. This is the code directly before it. It simply copies 22 rows from one sheet to the other so in total both pieces of code should copy 24 rows.


    [VB]
    'Copies top 22 runners into CityQualifiers
    Dim TeamRng As Range
    Set TeamRng = Range("A4:C25")
    TeamRng.Select
    Selection.Copy
    Sheets("CityQualifiers").Range("A" & Rows.count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
    [/VB]

    Re: Find cells based on values in different cell, copy and paste adjacent cells


    I had to modify my initial intent to find team runners if they finish outside the top 22 runners and then copy them into the RegionQualifiers sheet. This is the code.


    [VB]
    'Finds all three team runners if they finish outside of top 22 runners.
    bottomC = Range("c" & Rows.count).End(xlUp).Row
    bottomH = Range("h" & Rows.count).End(xlUp).Row

    For r = 4 To bottomH
    If Range("G" & r) = "1" Then FirstTeam = Trim(Range("H" & r))
    If Range("G" & r) = "2" Then SecondTeam = Trim(Range("H" & r))
    Next r

    Dim Counter As Integer
    Counter = 0
    For r = 3 To bottomC
    Set FirstCell = Range("A" & r)
    Set LastCell = Range("D" & r)
    If Range("A" & r).Offset(0, 2) = FirstTeam Then Counter = Counter + 1
    If Range("A" & r).Offset(0, 2) = FirstTeam And LastCell > 22 And Counter <= 3 _
    Then Range(FirstCell, LastCell.Offset(0, -1)).Copy _
    Destination:=Sheets("RegionQualifiers").Range("A1").End(xlDown).Offset(1, 0)
    Next r

    Counter = 0
    For r = 3 To bottomC
    Set FirstCell = Range("A" & r)
    Set LastCell = Range("D" & r)
    If Range("A" & r).Offset(0, 2) = SecondTeam Then Counter = Counter + 1
    If Range("A" & r).Offset(0, 2) = SecondTeam And LastCell > 22 And Counter <= 3 _
    Then Range(FirstCell, LastCell.Offset(0, -1)).Copy _
    Destination:=Sheets("RegionQualifiers").Range("A1").End(xlDown).Offset(1, 0)
    Next r

    'Copies Race Name into column D in RegionQualifiers.
    Dim myDest As Range
    Sheets("RegionQualifiers").Range("D" & Rows.count).End(xlUp)(2).Value = Range("a2").Value
    With Sheets("RegionQualifiers")
    Set myDest = .Range("a" & Rows.count).End(xlUp).Offset(, 3)
    With .Range("d" & Rows.count).End(xlUp)
    .AutoFill Sheets("RegionQualifiers").Range(.Cells, myDest), xlFillSeries
    End With
    End With
    [/VB]

    I have written this code to copy a range from one sheet to another and it works fine. However, I want to copy only the cell value without any formatting such as cell colour. I've tried a few different ways but it's not working for me. Any help would be great!


    [VB]
    Dim Counter As Integer
    Counter = 0
    For r = 3 To bottomC
    Set FirstCell = Range("A" & r)
    Set LastCell = Range("D" & r)
    If Range("A" & r).Offset(0, 2) = FirstTeam Then Counter = Counter + 1
    If Range("A" & r).Offset(0, 2) = FirstTeam And LastCell > 22 And Counter <= 3 _
    Then Range(FirstCell, LastCell.Offset(0, -1)).Copy _
    Destination:=Sheets("CityQualifiers").Range("A1").End(xlDown).Offset(1, 0)
    Next r
    [/VB]