VBA Macro - Loop and get value then ovewrite the desired cell

Question

I created a loop that will get the value of one cell to another cell under the same sheet. The expected result should be this, if the loop runs it will get the 1st value then run my created procedure next overwrite the same cell get the 2nd value then execute again my created procedure then get 3rd value .. overwrite the cell ..exec proc and so on ... But my codes only get the last value of the selection.

    Public Sub SpecNum()

    Dim lrow As Long

    Range("A2").Select
    lrow = Selection.End(xlDown).Row

        For x = 2 To lrow

            Range("C2").Value2 = Cells(x, 1).Value2

        Next x
            Number

    End Sub


    Public Sub Number()

    Dim SpecNum, pref, lastCell As String
    Dim lrow As Long

    SpecNum = Range("C2").Value2


        For x = 2 To 6

            Worksheets("Sheet3").Select
            pref = Cells(x, "E").Value2
            Cells(x, "C").Value2 = SpecNum & pref
            Range("C2", Range("C2").End(xlToRight).End(xlDown)).Copy

        Next x

            Worksheets("Sheet1").Select
            Range("A250").Select
            Selection.End(xlUp).Select
            ActiveCell.Offset(1, 0).Select
            ActiveSheet.Paste

    End Sub

output when moving the number inside the loop.. it doubled/tripled the values

expected result:

If *Number* is the name of the sub procedure that does the extra work, you need to move it 1 line uo inside the For ... Next loop. — , Oct 30 '18 at 03:34
@Jeeped, I moved it and it doubled/tripled the values here's my sub proc
Public Sub Number() Dim SpecNum, pref, lastCell As String Dim lrow As Long SpecNum = Range("C2").Value2 For x = 2 To 6 Worksheets("Sheet3").Select pref = Cells(x, "E").Value2 Cells(x, "C").Value2 = SpecNum & pref Range("C2", Range("C2").End(xlToRight).End(xlDown)).Copy Next x Worksheets("Sheet1").Select Range("A250").Select Selection.End(xlUp).Select ActiveCell.Offset(1, 0).Select ActiveSheet.Paste End Sub — Gabriel, Oct 30 '18 at 03:40
You should include the basic operational code from Numbers. It's impossible to determine what you are attempting from the information provided. — , Oct 30 '18 at 03:45
sorry for the details I don't know how to put format of the codes in replying — Gabriel, Oct 30 '18 at 03:45

score 0 · Answer 1 · answered Oct 30 '18 at 08:13

modified your loop structures. May try

Public Sub SpecNum()

    Dim lrow As Long

    Range("A2").Select
    lrow = Selection.End(xlDown).Row

        For X = 2 To lrow
        Range("C2").Value2 = Cells(X, 1).Value2
        Number
        Next X


    End Sub

    Public Sub Number()

    Dim SpecNum, pref, lastCell As String
    Dim lrow As Long

    SpecNum = Range("C2").Value2


        For X = 2 To 6

            Worksheets("Sheet3").Select
            pref = Cells(X, "E").Value2
            Cells(X, "C").Value2 = SpecNum & pref
            'Range("C2", Range("C2").End(xlToRight).End(xlDown)).Copy
            Range("C" & X, Range("C" & X).End(xlToRight)).Copy

            Worksheets("Sheet1").Select
            Range("A15").End(xlDown).End(xlDown).End(xlUp).Select
            ActiveCell.Offset(1, 0).Select
            ActiveSheet.Paste
    Next X

    End Sub

Or may please opt for simplified solution in single procedure

    Public Sub SpecNum2()

    Dim lrow As Long
    Worksheets("Sheet1").Range("A2").Select
    lrow = Selection.End(xlDown).Row
    TrgRw = 15

        For X = 2 To lrow
        NumX = Worksheets("Sheet1").Cells(X, 1).Value2


            For Y = 2 To 6
            TrgRw = TrgRw + 1
            Worksheets("Sheet3").Select
            pref = Cells(Y, "E").Value2
            Cells(Y, "C").Value2 = NumX & pref
            'Range("C2", Range("C2").End(xlToRight).End(xlDown)).Copy
            Range("C" & Y, Range("C" & Y).End(xlToRight)).Copy

            Worksheets("Sheet1").Select
            Range("A" & TrgRw).Select
            ActiveSheet.Paste
            Next Y
       Next X
End Sub

Hope It will work

Got missing combinations, missing from start and end. – Gabriel Oct 31 '18 at 01:46 — Gabriel, Oct 31 '18 at 01:46

score 0 · Accepted Answer · answered Oct 30 '18 at 08:33

I refactored your code a bit. First of all - you should learn how to avoid using Selections (How to avoid using Select in Excel VBA). Code without Selections is more flexible and less confusing.

Hope it works as you wanted:

Option Explicit
Public Sub SpecNum()
Dim lrow    As Long
Dim x       As Long
Dim wb      As Workbook
Dim ws      As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet3")

lrow = ws.Range("A2").End(xlDown).row

For x = 2 To lrow
    ws.Range("C2").Value2 = ws.Cells(x, 1).Value2
    Number
Next x
End Sub

Public Sub Number()
Dim SpecNum As String
Dim pref    As String
Dim lrow    As Long
Dim x       As Long
Dim wb      As Workbook
Dim ws3     As Worksheet
Dim ws1     As Worksheet
Set wb = ThisWorkbook
Set ws1 = wb.Worksheets("Sheet1")
Set ws3 = wb.Worksheets("Sheet3")

SpecNum = ws3.Range("C2").Value2

For x = 2 To 6
    pref = ws3.Cells(x, "E").Value2
    ws3.Cells(x, "C").Value2 = SpecNum & pref
Next x
ws3.Range("C2", ws3.Range("C2").End(xlToRight).End(xlDown)).Copy

ws1.Range("A250").End(xlUp).Offset(1, 0).PasteSpecial
End Sub

VBA Macro - Loop and get value then ovewrite the desired cell

2 Answers2