Help with Record VBA - Copy and paste numbers

[Mike Guest98]

I used the record VBA on this project but the program is not doing everything I need it to do. This is a small sample of a much bigger sheet2 that we’re using. Thank you in advance for any help you can provide.

Record output

Sub Macro ()

	Range(“D24”).Select
	ActiveCell.FormulaR1C1 = “6”
	Range(“F24”).Select
	ActiveCell.FormulaR1C1 = “3”
	Range(“J27”).Select
	ActiveCell.FormulaR1C1 = “8”
End Sub

We use VBA code (can provide if that helps) to find any number(s) in the cell range F1:F20. There are 3 found numbers, F3 with a 6.00, F12 with a 3.00 and F16 with a 8.00. We use the adjacent cell to the left of each found number cell as a reference number (1 to 10).

Searching cells D23,F23,H23,J23,L23,D26,F26,H26,J26,L26 for the reference number place the found number (eg. 8.00 from F16) in the appropriate cell, J27.
That’s it.

Thank you for all your help.

 

[Smitty]

For starters, there's no need to select. Just assign the value to the cell directly:

Range("D24").Value = 6

Searching cells D23,F23,H23,J23,L23,D26,F26,H26,J26,L26 for the reference number place the found number (eg. 8.00 from F16) in the appropriate cell, J27.

I have no idea what you're asking here, but have you tried a For Each...Next loop?

 

[Mike Guest98]

Thanks for your reply

The code is from the record in Excel not me. I need a find action first, then move. Well this is what I need:

We use VBA code (can provide if that helps) to find any number(s) in the cell range F1:F20. There are 3 found numbers, F3 with a 6.00, F12 with a 3.00 and F16 with a 8.00. We use the adjacent cell to the left of each found number cell as a reference number (1 to 10).

Searching cells D23,F23,H23,J23,L23,D26,F26,H26,J26,L26 for the reference number place the found number (eg. 8.00 from F16) in the appropriate cell, J27.
That’s it.

 

[Smitty]

Yes, if you have existing VBA code, it would be helpful to provide that. Make sure to point out where it's not doing what you want, and use code tags: [ code ] your code here [ /code ] (no spaces) to wrap your code for posting on the board.

It will also help if you post a clearer explanation of what you want. You can use the Mr.Excel HTML Maker to post a shot of your sheet for reference.

 

[Mike Guest98]

I’m a new Linux user and could not get the HTML maker to work but I think I’ve made it a lot clearer, sorry about that.

This is what we use to find any numbers in the range but I need to change the line "

Set Found = SearchCell.Find(What:=15, Lookat:=xlPart)

" from finding 15 to finding any number. Also if you could delete the turning red part. If you could assist on that one it would be great.

Code to find number:

Option Explicit
Sub Found()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet2")
Dim SearchRange As Range, SearchCell, Found As Range
Set SearchRange = ws.Range("F1:F20")
For Each SearchCell In SearchRange
    Set Found = SearchCell.Find(What:=15, Lookat:=xlPart)
    If Not Found Is Nothing Then
        Found.Interior.Color = vbRed
    End If
    Set Found = Nothing
Next SearchCell
End Sub

There are 3 found numbers, F3 with a 6.00 (adjacent cell to the left is E3 with a 1 in it), F12 with a 3.00 (adjacent cell to the left is E12 with a 2 in it) and F16 with a 8.00 (adjacent cell to the left is E16 with a 9 in it). We use the adjacent cell to the left of each found number cell as a reference number (1 to 10).

We need the code to search the following cells: D23 is reference no.1, F23 is reference no.2 ,H23 is reference no 3, J23 is reference no 4, L23 is reference no.5, D26 is reference no 6, F26 is reference no 7, H26 is reference no 8, J26 is reference no 9 and L26 is reference no 10.

So my found numbers from above the code would search cells D23,F23,H23,J23,L23,D26,F26,H26,J26,L26 for the reference number and place 6.00 from F3 in cell D23, 3.00 from cell F12 into cell F23 and 8.00 from cell F16 into cell J25.

That’s it. If you have any question please let me know. Really thank-you for all your help.

 

[Mike Guest98]

Hi

Are you still there?

 

[JackDanIce]

This is not clear I'm afraid.

Do you only want to replace the contents of D23, F23, H23, J23, L23 (Then same columns but row 26) if and only if it contains 6.00 (F6), 3.00 (F12) or 8.00 (F16)? Why does your code have 15 as value to be searched for?

Have you tried to replace the 15 in your code with a cell address to see if that works as expected?

What I've interpreted your ask as:

"If F6, F12 or F16 match D23, F23, H23, J23 , L23 (or match in same columns but across row 26), then replace the matched cell with value from adjacent E column, i.e. E6, E12, E16, Otherwise do nothing"

In otherwords a reverse VLOOKUP or INDEX+MATCH function?

Is J25 a typo? Can you explain

reference number of 1 to 10

has to with this?
Do you only care to replace with 3 cells (E6, E12, E16), so 1 to 10 is what? And what range is it in?

Sorry for further questions, it's trying to understand a problem when the PC screen or spreadsheet isn't visible and description non-succinct

Below turns the red interior fill off:

Sub Found()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet2")
Dim SearchRange As Range, SearchCell, Found As Range
Set SearchRange = ws.Range("F1:F20")
For Each SearchCell In SearchRange
    Set Found = SearchCell.Find(What:=15, Lookat:=xlPart)
    If Not Found Is Nothing Then
        'Found.Interior.Color = vbRed
    End If
    Set Found = Nothing
Next SearchCell
End Sub

 

[Mike Guest98]

Thanks so much for your reply I really do appreciate it. I have clarifyed the post below:

1st is to do a search in the cell range F1:F20 for any numbers, Cells are formatted as 000.00, You’re right we need to get rid of the search for 15 and the red fill)

2nd Any found numbers use the adjacent cell to the left of it as a reference number.

3rd Search cells D23,F23,H23,J23,L23,D26,F26,H26,J26,L26 for the reference number. Copy and paste any found number, no. 1 above in the cell below it.


So as an example the code found the number 6.00 in cell F3, the cell to the left is E3 with a 1 in it. Searching cells D23,F23,H23,J23,L23,D26,F26,H26,J26,L26 for a 1 it would find that in cell D23 and paste 6.00 in cell D24. It would do that for each found number.

That’s it.

Thank you so much for all your help. I will be visiting my sister for 1 week and when I get back I will start back at your code. Thanks again.

 

[JackDanIce]

Try:

Sub Found()

    Dim dic     As Object
    Dim arr()   As Variant
    Dim x       As Long
    Dim y       As Long
    
    Set dic = CreateObject("Scripting.Dictionary")
    arr = Cells(1, 5).Resize(20, 2).Value


    For x = LBound(arr, 1) To UBound(arr, 1)
        dic(arr(x, 2)) = arr(x, 1)
    Next x
    Erase arr
    
    x = Cells(Rows.Count, 12).End(xlUp).Row
    arr = Cells(23, 4).Resize(x - 22, 9).Value
    
    For x = LBound(arr, 1) To UBound(arr, 1)
        For y = LBound(arr, 2) To UBound(arr, 2)
            If Len(Trim(arr(x, y))) Then arr(x, y) = dic(Trim(arr(x, y)))
        Next y
    Next x
    
    Cells(23, 4).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
    Erase arr
    
    Set dic = Nothing
    
End Sub

 

[NoSparks]

another possibility

Sub MikeScooter()

Dim ws As Worksheet, cel As Range, searchRng As Range, fndrng As Range
    
Set ws = ThisWorkbook.Sheets("Sheet2")
With ws
    Set searchRng = Union(.Range("D23"), .Range("F23"), .Range("H23"), .Range("J23"), .Range("L23"), _
                    .Range("D26"), .Range("F26"), .Range("H26"), .Range("J26"), .Range("L26"))
                    
    For Each cel In .Range("F1:F20")
        If WorksheetFunction.IsNumber(cel.Value) Then
            Set fndrng = searchRng.Find(What:=cel.Offset(, -1).Value, _
                                        LookIn:=xlValues, _
                                        LookAt:=xlWhole, _
                                        SearchOrder:=xlByRows, _
                                        SearchDirection:=xlNext, _
                                        MatchCase:=False)
            If Not fndrng Is Nothing Then fndrng.Offset(1).Value = cel.Value
        End If
    Next cel
End With

End Sub