Search Range Macro Change

[Mike Guest98]

Hi

I have a macro, below, that works just fine but I was wondering if it’s possible to add one condition to it. If someone could just look to see if this is possible I would be very grateful.

- The macro searches for any number that is entered in cell B3.

- It searches the ranges C3:C20, F20: F40, I5:I 25, L 25:L40 (sample data ranges, many more) for the entered number. For a positive result the cell to the right of the entered number in cell B3 must have a #-# in it.

- The code then moves the set of numbers down one cell. As an example if there is a 1-1 in cell C3 the code would move it to cell C4 and the last number in the set would be increased by one to 1-2 (only the last number increases by one). The code is as follows:

If cell.Value = n And tmp Like "*#-#*" Then
         Cells(irow + 1, icol).Insert Shift:=xlDown
         Cells(irow, icol).Copy Cells(irow + 1, icol)
         Cells(irow, icol).Clear

My change is if the set of numbers is 1-10 (could be any number – 10, 4-10, 20-10 etc) the code would move the set of numbers down two cells instead of one cell. So as an example if cell C13 has a 1-10 the code would move it to cell C15 and the expected result would be 1-11.

If you have any questions please let me know.

Thank-you for any help.

Sub MOVE1DOWN()

Dim n, sht As Worksheet, cell As Range, num, tmp, rngDest As Range

    Set sht = ActiveSheet

    n = sht.Range("B3")

    For Each cell In sht.Range("C3:C20, F20: F40, I5:I 25, L 25:L40").Cells

        tmp = cell.Offset(0, 1).Value

        If cell.Value = n And tmp Like "*#-#*" Then

            'get the first number
            num = CLng(Trim(Split(tmp, "-")(0)))
            Debug.Print "Found a positive result in " & cell.Address

            'find the next empty cell in the appropriate row
         Set rngDest = sht.Cells(num, sht.Columns.Count).End(xlToLeft).Offset(0, 1)
            If rngDest.Column < 10 Then Set rngDest = sht.Cells(num, 10)

            cell.Offset(0, 1).Copy rngDest

            Rem Move the next row of cell contents to the next cell
	In sht.Range(“C3:C20, F20: F40, I5:I 25, L 25:L40”).Cells
              
        tmp = cell.Offset(0, 1).Value

        If cell.Value = n And tmp Like "*#-#*" Then
         Cells(irow + 1, icol).Insert Shift:=xlDown
         Cells(irow, icol).Copy Cells(irow + 1, icol)
         Cells(irow, icol).Clear

            Exit For
        End If
    Next
End Sub

 

[Mike Guest98]

I need to close this post it has the wrong macro and info. Sorry about that.