Using VBA code to return a cell to specific row

Question

just starting out with VBA and got stuck on this issue;

I have a resource sheet for people/equipment. The available equipment rows are lower in the sheet than the main work plan. I want to be able to select an item of equipment from the work plan and return it to the available equipment rows. The code below is what I have so far but it's not working. Not sure if it's because I have asked it to select activecell for 2 ranges? Rng1 is the cell I want to move. Rng2 is in the same column as Rng1 but lower down (I am trying to reference Rng1 with the same value in Column A to select the correct row). Hope that all makes sense :)

Public Sub Return_Equipment()
    Dim Name1 As String, Name2 As String, NameTemp As String, NameRef As String, Rng1 As Range, Rng2 As Range, Rng3 As Range, StatusVar As Boolean
    If IsEmpty(ActiveCell) Then
        MsgBox "Please select an item of equipment", vbOKOnly + vbInformation, "Selection Error"
        Exit Sub
    End If
    On Error GoTo errorhandler
    Set Rng1 = ActiveCell
    Do
        NameRef = Intersect(ActiveCell.EntireRow, ActiveCell.CurrentRegion.Columns(1)).Value
        If (ActiveCell.Value = NameRef) = False Then
            ActiveCell.Offset(1, 0).Select
        End If
    Loop Until (ActiveCell.Value = NameRef) = True
    ActiveCell
    Set Rng2 = ActiveCell
    Set Rng3 = Application.InputBox("Please select last date for returning", Type:=8)
    On Error GoTo 0
    StatusVar = False
    If IsEmpty(Rng2) Then
        StatusVar = True
        If WorksheetFunction.CountA(Range(Rng2.Address).Resize(, Range(Rng1.Address & ":" & Rng3.Address).Columns.Count)) <> 0 Then
            MsgBox "Not all cells are empty in the destination row! Please start again.", vbCritical + vbOKOnly, "Cell Allocation Error"
            Exit Sub
        End If
    End If

    '...
'errorhandler:
    '...
End Sub

I'll elaborate a little more regarding what I'm trying to do; In the picture below I want to return the trailer "Trailer 37U52 L4386 (for trk Ranger)" from cells IV:114 & IW:114 to IV:261 & IW:262 and clear data from IV:114 & IW:114. I start by selecting IV:114 and running the code. The code sets IV:114 to Rng1. Then it looks at Column A for the corresponding value (in this case A:261) and sets Rng2 as the cell in that row in the Rng1 column (IV:261). The end date is selected using the input box and sets Rng3 as the last column I want this change to be applied to (in the same row as Rng1) In this case I select a cell in column IW. It is then supposed to relabel cells IV:261 & IW:261 with the values from IV:114 & IW:114 and clear data from IV:114 & IW:114. What I see it doing when I run the code is setting IV:114 & IW:114 to "Temp Value" and then relabeling it back to "Trailer 37U52 L4386 (for trk Ranger)" Does that help anyone to see what is wrong with my code?

Picture of scenario

I'm not sure exactly what you want to do, but normally you want to [avoid using `Select`](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). — BigBen, Sep 17 '19 at 02:03
The "trick" to avoiding select/activate, is to work off a `Worksheet` object, say, `ws`; everything you want to do with that particular sheet, you do through this `ws` object variable. So if you need a variable to hold a reference to any particular `Range`, you can use its `Range` property like this: `ws.Range("A1")` to get a `Range` object representing the cell `[A1]` - and you didn't even need `ws` to be the `ActiveSheet` for that to happen! — Mathieu Guindon, Sep 17 '19 at 02:35
"Not working" is never a very helpful description of the problem. Please elaborate. — SJR, Sep 17 '19 at 07:23

David García Bodego · Answer 1 · 2019-09-19T09:34:55.210

According to your description, that one should work. It is not the cleanest version (you should mention worksheet...)

Public Sub Return_Equipment()
    Dim Name1, Name2, NameRef As String
    Dim Rng1, Rng2, Rng3  As Range
    Dim i, j as Long

    If IsEmpty(ActiveCell) Then
        MsgBox "Please select an item of equipment", vbOKOnly + vbInformation, _
                                                             "Selection Error"
        Exit Sub
    End If

    On Error GoTo errorhandler

    Set Rng1 = ActiveCell
    Set Rng2 = Cells(1, 1)
    j = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row - Rng1.Row
    For i = 1 to j
        If Rng1.Value = Cells(Rng1.Row + i, 1).Value  Then
            Set Rng2 = Cells(Rng1.Row + i, 1)
        End If
    Next

    If Rng2 = Cells(1, 1) Then
        MsgBox "There is no match"
        Exit Sub
    End if

    Set Rng3 = Application.InputBox("Please select last date for returning", Type:=8)

    For i=0 to abs(Rng1.Column - Rng3.Column)
        If Rng2.Offset(0, Rng1.Column + i).Value <> "" Then
             NameRef = "Fail"
             MsgBox "Not all cells are empty in the destination row! _
                    Please start again.", vbCritical + vbOKOnly, "Cell Allocation Error"
        End If
    Next
    If NameRef <>"Fail" Then
        For i=0 to abs(Rng1.Column - Rng3.Column)
            Cells(Rng2.Row, Rng1.Column + i).Value = _
                                    Cells(Rng1.Row, Rng1.Column + i).Value
            Cells(Rng1.Row, Rng1.Column + i).Value = ""
        Next
    End If

...
error handler
...

End Sub

Just check on the index "i" that it is working properly, maybe it is one unit short or long. It is difficult to reproduce your sheet to test it. Hope it helps!

In the code I send to you there are 2 `For` and 2 `Next`. So there shouldn´t be any "Next without For"... check the remaining code. Tip: Search for "Next" and "For" and the matches should be the same number. — David García Bodego, Sep 19 '19 at 04:19
I did not see the last one, it is my mistake... already edited and solved — David García Bodego, Sep 19 '19 at 05:21
All good, really appreciate the help you have given :) I'm still getting the same error though??? aarrrrgh — AndyWard, Sep 19 '19 at 06:25
Could you send me your worksheet or a sample? If not possible, could you edit the whole code... It is difficult to replicate if there is just a section. email_ID davidbodego@gmail.com — David García Bodego, Sep 19 '19 at 07:26

Using VBA code to return a cell to specific row

1 Answers1