Search code examples
excelvbaautomationduplicatesrows

Add next or previous letter with Excel VBA

I have data set like this

enter image description here

and I want to duplicate each row twice and add the next or previous letter in column "code". I am able to achieve the first goal (duplicate each row twice) but i am stuck to add the next or previous letter in column "code".

This i what I did :

Sub mysub()

Dim r As Range, n As Long, i As Long
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws1, ws2 As Worksheet
Set ws1 = wb.Sheets("Sheet1")
Set ws2 = wb.Sheets("Sheet2")

Set r = ws1.Range("C3", ws1.Range("E" & Rows.Count).End(xlUp))

For i = 1 To r.Rows.Count
    n = n + 1
    ws2.Cells(n + 1, 1).Value = r.Cells(i, 1).Value
    ws2.Cells(n + 1, 2).Value = r.Cells(i, 2).Value
    ws2.Cells(n + 1, 3).Value = r.Cells(i, 3).Value
    n = n + 1
    ws2.Cells(n + 1, 1).Value = r.Cells(i, 1).Value
    ws2.Cells(n + 1, 2).Value = r.Cells(i, 2).Value * -1
    
Next i


End Sub

and i get this

enter image description here

but I want to get this :

enter image description here

Some help would be appreciated

Solution

  • You were pretty close, only need one line added.

    You can slightly shorten the code using Resize.

    Sub mysub()

Dim r As Range, n As Long, i As Long
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws1 As Worksheet, ws2 As Worksheet 'need to specify each

Set ws1 = wb.Sheets("Sheet1")
Set ws2 = wb.Sheets("Sheet2")

Set r = ws1.Range("C3", ws1.Range("C" & Rows.Count).End(xlUp))

For i = 1 To r.Rows.Count
    n = n + 1
    ws2.Cells(n + 1, 1).Resize(2, 2).Value = r.Cells(i, 1).Resize(, 2).Value
    ws2.Cells(n + 1, 3).Value = r.Cells(i, 3).Value
    n = n + 1
    ws2.Cells(n + 1, 2).Value = r.Cells(i, 2).Value * -1
    ws2.Cells(n + 1, 3).Value = IIf(r.Cells(i, 3) = "C", "D", "C") 'added
Next i

End Sub