resize multiple columns-CodePudding

The last two days I've been trying to get the resize vba to work. I need 3 columns (Q,R,S) to be copied and pasted after column 19. This has to happen until the number of 3 column sets (i, copies of Q:S) is equal to the value in cell ("C18"), likewise, if the number of repeats of QRS is greater than the value in C18 the unnecessary copies should be deleted. The resize worked fine when it was just one column but now that I try to get a set of 3 added or deleted it goes wrong..the number of copies is not equal to the value in ("C18") and the number of copies made or deleted is not constant when I rerun the sub.

Does anyone have a solution?

Sub resize()

Dim SLastCol As Long
Dim i As Long

i = Range("C18").Value * 3
SLastCol = Cells(1, Columns.Count).End(xlToLeft).Column - 19 


If SLastCol < i Then
    Columns("Q:S").EntireColumn.copy
   Columns("T").EntireColumn.Resize(, Abs(SLastCol - i)).Insert shift:=xlToRight
ElseIf SLastCol > i Then
    Columns("T:W").EntireColumn.Resize(, Abs(SLastCol - i)).Delete shift:=xlToLeft
End If
Application.CutCopyMode = False

End Sub

CodePudding user response：

Please, test the next code. It will copy all columns in the range colsRng, as many times as is written in "C8":

Sub resizeColumnsCopy()
 Dim i As Long, colsRng As Range, lastCol As Long, rngDel As Range, arrCols, arrPrevCols
 
 'identify the previous processed columns and delete them, if any
 lastCol = cells(1, Columns.count).End(xlToLeft).Column
 arrPrevCols = Range(cells(1, 20), cells(1, lastCol)).Value 'place the headers after column 20 in an array
 arrCols = Range("Q1:S1").Value 'do the same with the copied columns headers
 For i = 1 To UBound(arrPrevCols, 2) Step 3  'iterate in the larger array, from three to three columns
    If arrPrevCols(1, i) = arrCols(1, 1) Then    'finding the first column header
        If rngDel Is Nothing Then
           Set rngDel = Range(cells(1, 19   i), cells(1, 19   i   2)) 'create a range of the three involved columns
        Else
            Set rngDel = Union(rngDel, Range(cells(1, 19   i), cells(1, 19   i   2))) 'careate a Union between the previous range and the next three
        End If
    End If
 Next i
 If Not rngDel Is Nothing Then rngDel.EntireColumn.Delete 'if cases of processed columns found, then delete the columns
 
 i = Range("C18").Value
 Set colsRng = Columns("Q:S")
    colsRng.Copy
    cells(1, colsRng.Column   colsRng.Columns.count).EntireColumn.resize(, i * colsRng.Columns.count).Insert Shift:=xlToRight
    Application.CutCopyMode = False
End Sub

But, please edit your question and explain about the necessity of previous processed columns deletion. Otherwise, somebody else looking to my code will think that I recently hit my head...