Replicate data into multiple cells

[shashwat Agarwal]

I have a list of customers in a sheet, I have to plot dates from 1st Jan 2019 to 31st Aug 2019 in front of each customers.

Can anyone suggest some Macro or VBA to do that quickly? Sample Sheet is attached for reference.

 

[AlanSidman]

With 2200 customer names, this may take a while to run

Option Explicit

Sub CustDates()
    Dim lr As Long, i As Long, j As Long
    lr = Range("B" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    j = 6
    For i = 4 To lr 'You may wish to test on a smaller number by changing lr to maybe 7 or 8 .  Be sure to change back once satisfied.
        Range("B" & i).Copy Cells(4, j + 1)
        Range("D4:D246").Copy Cells(4, j)
        Cells(4, j + 1).Copy Range(Cells(5, j + 1), Cells(246, j + 1))
        j = j + 3
    Next i
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
    MsgBox "complete"
End Sub

 

[shashwat Agarwal]

Thanks for your reply.

However I don't want to create a new column for each customer, it should come one after another like I have shown in the sample sheet for 2 customers.

Or is there any way to do tat...

 

[Marc L]

According to the attachment a beginner starter demonstration :​

Sub Demo1()
            Dim Rg As Range, R&
            [G3].CurrentRegion.Offset(1).Clear
            Application.ScreenUpdating = False
            R = 4
    With Range("D4", [D3].End(xlDown))
        For Each Rg In Range("B4", [B3].End(xlDown))
            Rg.Copy Cells(R, 7).Resize(.Count)
            R = R + .Count
        Next
           .Copy Range("H4", Cells(R - 1, 8))
    End With
            Application.ScreenUpdating = True
End Sub

Do you like it ? So thanks to click on bottom right Like !​

​

 

[Fluff13]

How about

Sub shashwatAgarwal()
    Dim Cl As Range, Rng As Range
   
    Set Rng = Range("D4", Range("D" & Rows.Count).End(xlUp))
    Range("G3:H3").Value = Array("Customer Codes", "Dates")
    For Each Cl In Range("B4", Range("B" & Rows.Count).End(xlUp))
        Cl.Copy Range("G" & Rows.Count).End(xlUp).Offset(1).Resize(Rng.Count)
        Rng.Copy Range("H" & Rows.Count).End(xlUp).Offset(1)
    Next Cl
End Sub

 

[shashwat Agarwal]

Thank you so much Fluff13

 

[YasserKhalil]

Hello. I think using arrays is better in your case

Sub Test()
    Dim a, b, i As Long, j As Long, k As Long
    
    a = Range("B4", Range("B" & Rows.Count).End(xlUp)).Value
    b = Range("D4", Range("D" & Rows.Count).End(xlUp)).Value
    ReDim c(1 To UBound(a) * UBound(b), 1 To 2)
    
    
    For i = LBound(a) To UBound(a)
        For j = LBound(b) To UBound(b)
            k = k + 1
            c(k, 1) = a(i, 1)
            c(k, 2) = b(j, 1)
        Next j
    Next i
    
    Range("J3").Resize(1, 2).Value = Array("Customer Codes", "Dates")
    Range("J4").Resize(UBound(c, 1), UBound(c, 2)).Value = c
End Sub

 

[Fluff13]

Thank you so much Fluff13

You're welcome & thanks for the feedback