Change duplicates with VBA

[Cinsault]

Hi all!

In excel I have created a standard order template that should be used to create standard read-in files. I have managed to set up the standard read-in file with VBA, but I am stuck on one of the steps that must be taken in the preparation of the data.

Sample: https://ibb.co/dh48uH

From line 8, columns A through E will always be filled. However, the number of lines differs per file. What I try to achieve through VBA is:

1. All lines that have the text "A + B" in column C must be duplicated.
2. Of all duplicated lines, the text "A + B" in column C should be replaced with "B".
3. Of the remaining (actually original) lines with the text "A + B" in column C, it should be replaced with "A".

The end result would then be that in column C only the values ​​A or B occur.

I, as a beginner in VBA, have succeeded in the first step (although probably clumsy in the eyes of experts) but have no idea how to proceed. The things I tried based on google/YouTube doesn't work. I really hope someone can help me with this.

Sub CreateDuplicates()

    a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    For i = 8 To a

    If Worksheets("Sheet1").Cells(i, 3).Value = "A + B" Then
        Worksheets("Sheet1").Rows(i).Copy
        Worksheets("Sheet1").Activate
        a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("Sheet1").Cells(a + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("Sheet1").Activate
    End If
    Next i

Application.CutCopyMode = False
ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).Select

End Sub

Thanks in advance for your time & help!

 

[Fluff]

Hi & welcome to MrExcel.
How about

Sub CreateDuplicates()
   Dim a As Long, i As Long
   a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
   With Worksheets("Sheet1")
      For i = a To 8 Step -1
         If .Cells(i, 3).Value = "A + B" Then
            .Rows(i).Copy
            .Rows(i).Insert
            .Cells(i, 3).Value = "A"
            .Cells(i + 1, 3).Value = "B"
         End If
      Next i
   End With

Application.CutCopyMode = False
ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).Select

End Sub

 

[Cinsault]

Hi Fluff,


I immediately tried the code and it seems to work perfectly. Thank you so much for the quick response. I'm going to take the time to understand the code step by step - I enjoy working with vba. There's so much to learn!

 

[Fluff]

Glad to help & thanks for the feedback.