Code to write numbers from one cell to another

You must learn to attach a spreadsheet rather than an image.


Attach a sample workbook (not a picture or pasted copy). Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are shown, mock them up manually if necessary.

Remember to desensitize the data.

Click on GO ADVANCED and then scroll down to Manage Attachments to open the upload window.

Sub test()
'Searching cells B3, B4, E3, E4 to determine if any numbers are present.
''
SearchA = Split("B3, B4, E3, E4", ", ")
TargetA = Split("A14, E14, I14, L14", ", ")

For Count = 0 To 3
If IsNumeric(Range(SearchA(Count)).Value) Then

'Search for the same number in cells A14, E14, I14, L14
For Count2 = 0 To 3
If Range(SearchA(Count)).Value = Range(TargetA(Count2)).Value Then
T = Split(Range(SearchA(Count)).Offset(0, 1).Value, ".")
Range(TargetA(Count2)).Offset(0, 1).Value = T(0) & ".1"
End If
Next


End If
Next

End Sub

Try

Sub twst()
Dim r as range,t,dic as object,c as range
Set r =[b3:f4]
Set dic = CreateObject("Scripting.dictionary")
For each c in r
 If isnumeric(c.value) = true then
    t = split(c.offset(,1).value,"-")
    dic(c.value) = t(0) & "-" & 1
 End if
Next c
r.clear
For each c in rows(14).specialCells(2,1)
  If dic.exists(c.value) then
    c.offset(,1).value = dic(c.value)
  End if
Next c
End sub

try this work

Sub twst()
Dim r As Range, t, dic As Object, c As Range
Set r = [b3:f4]
Set dic = CreateObject("Scripting.dictionary")
For Each c In r
 If IsNumeric(c.Value) * Len(c.Value) = True Then
    t = Split(c.Offset(, 1).Value, "-")
    dic(c.Value) = "'" & t(0) & "-" & 1
 End If
Next c
' r.Clear
For Each c In Rows(14).SpecialCells(2, 1)
  If dic.exists(c.Value) Then
    c.Offset(, 1).Value = dic(c.Value)
  End If
Next c
End Sub

Sub test()
'Searching cells B3, B4, E3, E4 to determine if any numbers are present.
''
SearchA = Split("B3, B4, E3, E4", ", ")
TargetA = Split("A6, E6, I6, L6", ", ")

For Count = 0 To 3
If IsNumeric(Range(SearchA(Count)).Value) Then

'Search for the same number in cells A14, E14, I14, L14
For Count2 = 0 To 3
If Range(SearchA(Count)).Value = Range(TargetA(Count2)).Value * 1 Then
T = Split(Range(SearchA(Count)).Offset(0, 1).Value, "-")
Range(TargetA(Count2)).Offset(0, 1).Value = T(0) & ".1"
End If
Next

End If
Next

For Count = 0 To 3
Range(SearchA(Count)).Resize(1, 2).Value = ""
Next

End Sub

Don't hardcode the loop boundaries. Use:

For Count = LBound(SearchA) To UBound(SearchA)

and:

For Count2 = LBound(TargetA) To UBound(TargetA)

what additional cells are you talking about?

my 2 cents:

Sub scott1945()

Dim srng As Range
Dim drng As Range
Dim sVal As Variant, fVal As Variant

Set srng = Range("B3:B4, E3:E4")
Set drng = Range("A14, E14, I14, L14")

For Each sVal In srng
    If sVal.Value <> "" Then
        Set fVal = drng.Find(sVal, lookat:=xlWhole)
            If Not fVal Is Nothing Then
                fVal.Offset(, 1) = Left(sVal.Offset(, 1), InStr(sVal.Offset(, 1), "-")) & "1"
            End If
    End If
Next
End Sub

like this

Next
srng.ClearContents
srng.offset(,1).ClearContents
End Sub