Loop and copy paste part numbers based on qty

[rajkumar]

hi

i want to copy paste part numbers based on its qty to adjacent columns

please help with vba code for it, in the attached picture part number last digit become incremented, since i dragged to copy. part number should remain same in column A as well as in copied places

regards
raj


16-Mar-18 08-14-25.jpg

[YasserKhalil]

Hello Raj
Try this code

Sub Test()
    Dim c           As Range


    With Cells(1).CurrentRegion
        With .Offset(1).Resize(.Rows.Count - 1)
            For Each c In .Columns(7).Cells
                If IsNumeric(c.Value) And c.Value > 1 Then
                    c.Offset(, -5).Resize(, c.Value - 1).Value = c.Offset(, -6).Value
                End If
            Next c
        End With
    End With
End Sub

[rajkumar]

Hello Raj
Try this code

Sub Test()
    Dim c           As Range


    With Cells(1).CurrentRegion
        With .Offset(1).Resize(.Rows.Count - 1)
            For Each c In .Columns(7).Cells
                If IsNumeric(c.Value) And c.Value > 1 Then
                    c.Offset(, -5).Resize(, c.Value - 1).Value = c.Offset(, -6).Value
                End If
            Next c
        End With
    End With
End Sub

Hi YasserKhalil

thanks for your reply
this table is in a middle of a worksheet, i am attaching a sample
please support

FX Warranty Claims.xlsxFX Warranty Claims.xlsxFX Warranty Claims.xlsx

[YasserKhalil]

Try this modification

Sub Test()
    Dim c           As Range


    With Range("H1:O" & Cells(Rows.Count, "H").End(xlUp).Row)
        With .Offset(1).Resize(.Rows.Count - 1)
            For Each c In .Columns(8).Cells
                If IsNumeric(c.Value) And c.Value > 1 Then
                    c.Offset(, -6).Resize(, c.Value - 1).Value = c.Offset(, -7).Value
                End If
            Next c
        End With
    End With
End Sub

[rajkumar]

Try this modification

Sub Test()
    Dim c           As Range


    With Range("H1:O" & Cells(Rows.Count, "H").End(xlUp).Row)
        With .Offset(1).Resize(.Rows.Count - 1)
            For Each c In .Columns(8).Cells
                If IsNumeric(c.Value) And c.Value > 1 Then
                    c.Offset(, -6).Resize(, c.Value - 1).Value = c.Offset(, -7).Value
                End If
            Next c
        End With
    End With
End Sub

thanks perfectly working

[YasserKhalil]

You're welcome. Glad I can offer some help