CODEWITHSUNDEEP
vbaexcel
Meules
Meules

Reputation: 1389

Excel add and copy row values based on the amount of matches

First of all I'm completely new to VB and have not much experience with Excel. Second I'm not sure if this is the correct forum to ask this question, but I saw more questions regarding my issue.

I have an Excel sheet with two columns with id's in it. Something like this: enter image description here

As you can see in the first picture (in column 1) you have 3 equal id's (in blue). In the second column you have that same id (on second row) just one time. Is there a way to create some sort of function to duplicate the second column as many times as the first column has that id? So it looks like the second image: enter image description here

EDIT: The idea of the function/formula is that rows shift down. Not every ID in column 1 has multiple same ID's. For example the black cell is just a single one.Further column A is used as reference and only column b to F should be "changed".

I tried programs like Kutools to accomplish this but without success. Since the sheet has around 15k rows it would take a lot off time to do it by hand.

I'm able to add an empty row with VB when a cell matches a value, but I'm not able to copy.

I tried this which obviously doesn't work:

Sub BlankLine()

    Dim Rng As Range
    Dim WorkRng As Range
    On Error Resume Next
    xTitleId                   = "MyTest"
    Set WorkRng                = Application.Selection
    Set WorkRng                = Application.InputBox("Range", xTitleId, WorkRng.Address, Type: = 8)
    Set WorkRng                = WorkRng.Columns(1)
    xLastRow                   = WorkRng.Rows.Count
    Application.ScreenUpdating = False
    For xRowIndex = xLastRow To 1 Step - 1
        Set Rng                   = WorkRng.Range("A" & xRowIndex)
        If Rng.Value = "0" Then
            Rng.Offset(1, 0).EntireRow.Insert Shift: = xlDown
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Is this even possible and is somebody willing to give some directions? Thanks in advance...

Upvotes: 1

Views: 71

Answers (1)

dwirony
dwirony

Reputation: 5450

Here's a small example - without being able to see more of your data, it's impossible to know where to go from here. 

Sub Test()

Dim i As Long
Dim id As String

For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    id = Cells(i, 1).Value
    If Cells(i + 1, 1).Value = id And Cells(i + 1, 2).Value <> id Then
        Range(Cells(i + 1, 2), Cells(i + 1, 6)).Insert Shift:=xlDown
        Range(Cells(i + 1, 2), Cells(i + 1, 6)).Value = Range(Cells(i, 2), Cells(i, 6)).Value
    End If
Next i

End Sub

img1

Upvotes: 1

Related Questions