Replacing first 6 characters of a sequence in VBA

[Anthony Norton]

Hi Guys,

Got a bugging problem. I have attached an excel file to illustrate this issue. In Sheet1 is the current state of data I get, Sheet2 is what I want to achieve using VBA. However, all changes are to be done in the same sheet. Below is my code:

Option Explicit

Sub DuplicateRowsInGroups()
Dim arrOLD As Variant, arrNEW As Variant
Dim Rw As Long, Col As Long, NewRw As Long, LR As Long, i As Long
Dim FR As Long, oldNUM As String, newNUM As String

LR = Range("A" & Rows.Count).End(xlUp).Row
arrOLD = Range("A2:C" & LR).Value
ReDim arrNEW(1 To LR * 2, 1 To 3)
NewRw = 1
For Rw = 1 To UBound(arrOLD)
If FR = 0 Then
FR = Rw
oldNUM = arrOLD(Rw, 1)
newNUM = Mid(oldNUM, InStr(oldNUM, "-"), 100)
End If

For Col = 1 To 3
arrNEW(NewRw, Col) = arrOLD(Rw, Col)
Next Col
NewRw = NewRw + 1
If Rw = UBound(arrOLD) Then
For i = FR To Rw
arrNEW(NewRw, 1) = newNUM
arrNEW(NewRw, 2) = -arrOLD(i, 2)
arrNEW(NewRw, 3) = arrOLD(i, 3)
NewRw = NewRw + 1
Next i
Exit For
ElseIf arrOLD(Rw, 1) <> arrOLD(Rw + 1, 1) Then
For i = FR To Rw
arrNEW(NewRw, 1) = newNUM
arrNEW(NewRw, 2) = -arrOLD(i, 2)
arrNEW(NewRw, 3) = arrOLD(i, 3)
NewRw = NewRw + 1
Next i
FR = 0
End If
Next Rw

Range("A:A").NumberFormat = "@"
Range("A2:C2").Resize(UBound(arrNEW)).Value = arrNEW
End Sub

This code works fine in terms of inserting rows and copying values from the above columns. But if you refer to my excel, I would like the column A Number to be tagged to the Description. For eg, if the Description is "RECL FOR ABC", the digit before "-" in column A should reflect 1. If the Description is "RECL FOR XYZ, the digit before "-" should be 2. All digits after "-" should be the same as the cells above the inserted rows. Pls help thanks. I feel this should be more simple than it seems.

 

[jindon]

Logically explain why col.A in your result are not consistent?

 

[Anthony Norton]

So the highlighted cells in Sheet2 are the inserted rows after running my code. The column A values are supposed to be similar to the cells above, except that the digit before "-" now corresponds to the Description, whereby "RECL FOR ABC" corresponds to "1-x", where x is the number that is copied from the cells above.

 

[Anthony Norton]

My code is able to take care of the inserted contents for column B and C but not for A. This is where i need your help.

 

[jindon]

Sub test()
    Dim x, i As Long, ii As Long, iii As Long, iv, a, b, n As Long, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    With Cells(1).CurrentRegion
        a = .Value: ReDim b(1 To UBound(a, 1) * 2 - 1, 1 To UBound(a, 2))
        With .Columns(1)
            x = Filter(Evaluate("transpose(if(" & .Address & "<>" & _
                .Offset(1).Address & ",row(1:" & .Rows.Count & ")))"), False, 0)
        End With
        For i = 0 To UBound(x) - 1
            For ii = 1 To 2
                For iii = x(i) + 1 To x(i + 1)
                    If Not dic.exists(a(iii, 3)) Then dic(a(iii, 3)) = dic.Count + 1
                    n = n + 1
                    For iv = 1 To UBound(a, 2)
                        b(n, iv) = a(iii, iv)
                        If ii = 2 Then
                            If iv = 1 Then
                                b(n, iv) = dic(a(iii, 3)) & "-" & Split(a(iii, iv), "-")(1)
                            ElseIf iv = 2 Then
                                 b(n, iv) = b(n, iv) * -1
                            End If
                        End If
        Next iv, iii, ii, i
    End With
    With [f1].Resize(, UBound(b, 2))
        .Value = a
        .Rows(2).Resize(n).Value = b
    End With
End Sub

 

[jindon]

Cross post

http://www.excelforum.com/excel-pro...1574-insert-rows-copy-and-pasting-on-vba.html

 

[Hui]

Anthony

Please note the sites rules:
http://forum.chandoo.org/link-forums/new-users-please-read.17/

Please advise in the future about cross posting
It is generally frowned upon, as we may be wasting our time trying to resolve it here but it was already answered elsewhere and you haven't told us.

Whilst answering your post we are also not looking after other posts which may need our attention