0

I have a macro that works but I would like to change the cell range from

Set SearchRange = Range("E1:E12") to  
Set SearchRange = Range("A21:A32")

I have made the change in the code but it won’t work when I run it and I’m not sure what the issue is. I have an explanation below the code.

Sub Part()
    Dim SearchRange As Range, _
        DashPair    As Variant, _
        PairParts   As Variant, _
        SearchVal   As Variant, _
        FoundPos    As Variant, _
        NextCol     As Long

    Set SearchRange = Range("A21:A32")
    For Each DashPair In Range("B17, F17, J17")
        Err.Clear
        NextCol = 1
        If DashPair.Value <> "" Then
            PairParts = Split(DashPair, "-")
            If PairParts(1) = "15" Then
                SearchVal = DashPair.Offset(RowOffset:=1).Value

                On Error Resume Next
                 Set FoundPos = SearchRange.Find(SearchVal, LookAt:=xlWhole)
                If Not FoundPos Is Nothing Then
                    FoundPos = FoundPos.Row
                    ' find first empty column right of E
                    While SearchRange(FoundPos).Offset(ColumnOffset:=NextCol).Value <> ""
                        NextCol = NextCol + 1
                    Wend

                    PairParts(1) = PairParts(1) + 1
                    PairParts = Join(PairParts, "-")

                    With SearchRange(FoundPos).Offset(ColumnOffset:=NextCol)
                        .NumberFormat = "@"
                        .Value = "" & PairParts & ""
                    End With

                    DashPair.Resize(ColumnSize:=3).ClearContents
                End If
            End If  '15 found
        End If
    Next DashPair
End Sub

Example with expected result.

  • Please see my Excel example, the macro searches for a 15 (as a last number 20-15 etc.) in only cells B17, F17 and J17 currently. When it has a positive result it references the cell below it and uses that number to search cells A21:A32 for a match and place the copy and paste in the adjacent cell to the right of it.

  • Example: cell B30 has a 20-15, using the cell below, B18 has a 1 in it. 1 is the search number in the range A21:A32. Once found in A21:A32 range place the 20-15 in the adjacent cell to the right (B21) and increase the last number by 1 so it becomes 20-16.

  • Does the same with all cells: B17, F17 and J17.

  • After the write deletes all contents in cell B17/C17/D17. There are are two examples in my Excel sheet where the same thing needs to happen.

excel sheet

0

The problem with your code lies within SearchRange(FoundPos). This only works in this application if the SearchRange range starts at row 1.

By changing the range to A21:A32, your FindPos variable will be 21 for the first case.
This results in SearchRange(FoundPos) returning the 21th row of your range, namely A41.

Lots of ways to fix this, but to make minimal changes in the code, you could try replacing SearchRange(FoundPos) with ActiveSheet.Cells(FoundPos, SearchRange.Column).

  • Thanks for the advice. I will try it out. – KAREN KENDALL Nov 30 '18 at 15:34
  • Hi, I changed the code to While ActiveSheet.Cells(FoundPos, SearchRange.Column).Offset(ColumnOffset:=NextCol).Value <> "" and With ActiveSheet.Cells.Offset(ColumnOffset:=NextCol) I’m getting an error 9 – subscript out of range. I’m getting there using VBA but definitely could use some help if you have time. – KAREN KENDALL Nov 30 '18 at 19:27
  • I hope you mean With ActiveSheet.Cells(FoundPos, SearchRange.Column).Offset(ColumnOffset:=NextCol), you need to specify the cell. – Christofer Weber Nov 30 '18 at 19:36
  • A blond moment, fixed the "With" but now the message is "Wend without While" – KAREN KENDALL Nov 30 '18 at 19:57
  • Should be pretty clear where that went wrong though. Can't really help with that without seeing what you did. – Christofer Weber Nov 30 '18 at 20:48

Your Answer

By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.

Not the answer you're looking for? Browse other questions tagged or ask your own question.