How to drag data to next line?-CodePudding

Good afternoon,

I have a table where column A has the customer's data and column B has the customer's name. In columns C to L have the invoice information for that customer. I would like to get a vba code for when there is data in column A and B, create a row above the total and drag 1 row down the invoice information, looking like this:

A2 and B2 with the customer's code and name;

C3:L8 with customer invoice information;

Line nine: Total line (I already have this code)

Sub table_customer()

Range("A1:L1").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.349986266670736
    .PatternTintAndShade = 0
End With
Range("A1").Select
ActiveCell.FormulaR1C1 = "Code"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Customer"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Type Doc."
Range("D1").Select
ActiveCell.FormulaR1C1 = "Reference"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Data doc."
Range("F1").Select
ActiveCell.FormulaR1C1 = "Due date"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Currency"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Value eur"
Range("I1").Select
ActiveCell.FormulaR1C1 = "days delay"
Range("J1").Select
ActiveCell.FormulaR1C1 = "overdue v"
Range("K1").Select
ActiveCell.FormulaR1C1 = "Obs."
Range("L2").Select
Selection.AutoFill Destination:=Range("L1:L2"), Type:=xlFillDefault
Range("L1:L2").Select
Range("A2").Select
ActiveCell.FormulaR1C1 = "123"
Range("B2").Select
ActiveCell.FormulaR1C1 = "kkk"
Range("C2").Select
ActiveCell.FormulaR1C1 = "qq"
Range("D2").Select
ActiveCell.FormulaR1C1 = "qq"
Range("E2").Select
ActiveCell.FormulaR1C1 = "qq"
Range("F2").Select
ActiveCell.FormulaR1C1 = "qq"
Range("G2").Select
ActiveCell.FormulaR1C1 = "qq"
Range("H2").Select
ActiveCell.FormulaR1C1 = "qq"
Range("I2").Select
ActiveCell.FormulaR1C1 = "qq"
Range("J2").Select
ActiveCell.FormulaR1C1 = "qq"
Range("K2").Select
ActiveCell.FormulaR1C1 = "qq"
Range("C3").Select
ActiveCell.FormulaR1C1 = "tt"
Range("D3").Select
ActiveCell.FormulaR1C1 = "tt"
Range("E3").Select
ActiveCell.FormulaR1C1 = "tt"
Range("F3").Select
ActiveCell.FormulaR1C1 = "tt"
Range("G3").Select
ActiveCell.FormulaR1C1 = "tt"
Range("H3").Select
ActiveCell.FormulaR1C1 = "tt"
Range("I3").Select
ActiveCell.FormulaR1C1 = "tt"
Range("J3").Select
ActiveCell.FormulaR1C1 = "tt"
Range("K3").Select
ActiveCell.FormulaR1C1 = "tt"
Range("C4").Select
ActiveCell.FormulaR1C1 = "yy"
Range("D4").Select
ActiveCell.FormulaR1C1 = "yy"
Range("E4").Select
ActiveCell.FormulaR1C1 = "yy"
Range("F4").Select
ActiveCell.FormulaR1C1 = "yy"
Range("G4").Select
ActiveCell.FormulaR1C1 = "yy"
Range("H4").Select
ActiveCell.FormulaR1C1 = "yy"
Range("I4").Select
ActiveCell.FormulaR1C1 = "yy"
Range("J4").Select
ActiveCell.FormulaR1C1 = "yy"
Range("K4").Select
ActiveCell.FormulaR1C1 = "yy"
Range("C5").Select
ActiveCell.FormulaR1C1 = "pp"
Range("D5").Select
ActiveCell.FormulaR1C1 = "pp"
Range("E5").Select
ActiveCell.FormulaR1C1 = "pp"
Range("F5").Select
ActiveCell.FormulaR1C1 = "pp"
Range("G5").Select
ActiveCell.FormulaR1C1 = "pp"
Range("H5").Select
ActiveCell.FormulaR1C1 = "pp"
Range("I5").Select
ActiveCell.FormulaR1C1 = "pp"
Range("J5").Select
ActiveCell.FormulaR1C1 = "pp"
Range("K5").Select
ActiveCell.FormulaR1C1 = "pp"
Range("A6").Select
ActiveCell.FormulaR1C1 = "Total"
Range("A6:K6").Select
Range("K6").Activate
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.349986266670736
    .PatternTintAndShade = 0
End With
Rows("6:6").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C2:K5").Select
Selection.Cut Destination:=Range("C3:K6")
Range("C3:K6").Select
End Sub

According to the print, the objective is to move the information in order to obtain the line (which is currently in yellow). That's the ultimate goal. Currently, I have the information 1 line above, the information being right in front of the customer's names. As you can see, not all customers have the same number of invoices. My idea is that the vba code should read the cell of column A that has the "Total", then add a row above the total row, and finally shift the information down.

CodePudding user response：

Before you read this keep in mind the last time i actively programmed is like 4 years ago. Means the code is messy, not optimized, blah blah blah

So as requested to get a list like this:

to a format like this:

you can use the following code snippet. The "CommandButton1_Click()" function is only there because I use it as my trigger from a userform. the "adjustList" method can be called from wherever you like.

Basically I read all the customer data blocks into two dimensional arrays and clear the cells. After all entries are collected in the array and all cells are clear i write the data into the cells again with the requested format.

Also as requested this function can handle entries independent of how many rows they contain per customer, as shown in my screenshots.

Private Sub CommandButton1_Click()
    Call adjustList
End Sub

Function saveEntry(x As Integer, y As Integer) As Variant
    Dim tmpColumns(10) As String
    Dim tmpRows()
    Dim i As Integer
    Dim e As Integer
    Dim numOfRowsForEntry As Integer
    
    Cells(x, 1).Select
    numOfRowsForEntry = 0
    Do Until ActiveCell = "Total"
        Cells(x   numOfRowsForEntry, 1).Select
        numOfRowsForEntry = numOfRowsForEntry   1
    Loop
    
    ReDim tmpRows(numOfRowsForEntry - 1)
    
    For i = 0 To UBound(tmpRows) - LBound(tmpRows)
        For e = 0 To 10
            tmpColumns(e) = ""
            tmpColumns(e) = Cells(x   i, y   e).Text
            Cells(x   i, y   e) = ""
            Cells(x   i, y   e).Interior.Color = xlNone
        Next
        
        tmpRows(i) = tmpColumns
    Next
    
    saveEntry = tmpRows
    Exit Function
End Function

Sub adjustList()
    Dim x As Integer
    Dim i As Integer
    Dim startRowOfList As Integer
    Dim entryList()
    
    Application.ScreenUpdating = False
    
    startRowOfList = 2
    NumRows = Cells(Rows.Count, 1).End(xlUp).Row
    'ReDim entryList(NumRows / 2) 'every customer has at least 2 lines
    ReDim Preserve entryList(0)
    Cells(startRowOfList, 3).Select
    
    i = 0
    For x = startRowOfList To NumRows
        Cells(x, 1).Select
        If Not IsEmpty(ActiveCell) And Not ActiveCell = "Total" Then
            entryList(i) = saveEntry(ActiveCell.Row, ActiveCell.Column)
            ReDim Preserve entryList(UBound(entryList) - LBound(entryList)   1)
            i = i   1
        End If
    Next
    
    Cells(startRowOfList, 1).Select
    For x = 0 To UBound(entryList) - LBound(entryList) - 1
        For i = 0 To UBound(entryList(x)) - LBound(entryList(x))
            If entryList(x)(i)(0) = "Total" Then
                ActiveCell.Offset(1, 0) = entryList(x)(i)(0)
                For e = 0 To 10
                    ActiveCell.Offset(1, e).Interior.ColorIndex = 15
                Next
            Else
                ActiveCell = entryList(x)(i)(0)
                ActiveCell.Offset(0, 1) = entryList(x)(i)(1)
            End If
            ActiveCell.Offset(1, 2) = entryList(x)(i)(2)
            ActiveCell.Offset(1, 3) = entryList(x)(i)(3)
            ActiveCell.Offset(1, 4) = entryList(x)(i)(4)
            ActiveCell.Offset(1, 5) = entryList(x)(i)(5)
            ActiveCell.Offset(1, 6) = entryList(x)(i)(6)
            ActiveCell.Offset(1, 7) = entryList(x)(i)(7)
            ActiveCell.Offset(1, 8) = entryList(x)(i)(8)
            ActiveCell.Offset(1, 9) = entryList(x)(i)(9)
            ActiveCell.Offset(1, 10) = entryList(x)(i)(10)
            ActiveCell.Offset(1, 0).Select
        Next
        
        ActiveCell.Offset(1, 0).Select
    Next
        
    Application.ScreenUpdating = True
End Sub