How do I insert blank columns based on certain conditions? - excel

Question

I wanted to insert certain number of blank columns.
For example, row 1 column 1 is Q1, and row 1 column 2 is Q2, thus I dont need to insert any blank column.
If row 1 column 4 is Q5, row 1 column 3 is Q3, thus i want to insert (5-3-1) 1 blank column, a column to accommodate for Q4
Picture of the table is attached below.
https://imgur.com/NSatL9w
Sorry this is my first time writing on VBA. Any help is greatly appreciated.
Updated
Below is the error message displayed.
Compile error: Expected array
Option Explicit
Sub Test()
Dim lCol As Integer
Dim pos() As Long
Dim pos1() As Long
Dim strString() As String
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To lCol
If Left(Sheets(1).Cells(1, i).Value, 1) = "Q" Then
pos(i) = InStr(1, Cells(1,i), "Q") + 1
pos1(i) = InStr(pos(i), Cells(1,i), "<")
strString(i) = Mid(Cells(1,i), pos(i), pos1(i) - pos(i))
If strString(i + 1) - strString(i) > 1 Then
Columns(strString(i)+1:strString(i+1)-1).Insert
Shift:=xlToRight
End If
End If
Next i
End Sub

Answer 1

You have declared pos, pos1 and strStringas Integers then in your code you are using them as Arrays: pos(i), pos1(i), and strString(i+1). That is why you are getting the compile error Expected Array.
Also, when adding rows you need to move from the bottom up or adding columns from right to left. your counter should go from lCol to 1 Step -1.
You need to fully qualify your objects as well. Cells with no qualifier for which sheet will use whatever sheet is the active sheet, not necessarily the one you want to affect.

Answer 2

For the specific error, the variables pos, pos1 and strString need to be declared as arrays as we store multiple values and not only a single one.
This could be done in several difference ways:
'Method 1 : Using Dim
Dim arr1() 'Without Size
'Method 2 : Mentioning the Size
Dim arr2(5) 'Declared with size of 5
'Method 3 : using 'Array' Parameter
Dim arr3
arr3 = Array("apple","Orange","Grapes")
I will use Method 1, and after I know how many columns we need, I will resize/define the array so it will look like Method 2.
ActiveCell will not work as it refer to a single selection, so we need to change that to a dynamic reference.
Since you will add columns, your "total" range will be change for each inserted column. So if you have 14 columns from the beginning, you might miss the last ones as your range will have increased. I therefore recommend to start from right and loop to the left.
I also automatically added the headers for the new inserted column. Thought it could be a nice feature.
This code is hopefully something that can help you along:
Option Explicit
Sub test()
Dim lCol As Integer
Dim pos() 'Dim the variable as Array
Dim pos1() 'Dim the variable as Array
Dim strString() 'Dim the variable as Array
Dim i As Long 'Dim the variable i which will hold the position
Dim j As Long 'Dim the variable j which will loop for new inserted headers
Dim k As Long 'Dim the dummy variable k which will add one number for each empty header, between two quarters
lCol = Cells(1, Columns.Count).End(xlToLeft).Column 'Find the last column to loop through
ReDim pos(0 To lCol) 'When we know how many columns to loop through we can resize our array for the variable pos
ReDim pos1(0 To lCol) 'Same logic as above
ReDim strString(0 To lCol) 'Same logic as above
For i = lCol + 1 To 1 Step -1 'Since we want to insert a new column our "complete range will change". Therefore we start backwards and to Column A
If Left(Sheets(1).Cells(1, i).Value, 1) = "Q" Then 'Check if cell in row 1 starts with letter Q
pos(i) = InStr(1, Cells(1, i), "Q") + 1 'Get position for Q and add 1
pos1(i) = InStr(pos(i), Cells(1, i), "<") 'Get position for sign "<"
strString(i) = Mid(Cells(1, i), pos(i), pos1(i) - pos(i)) 'Extract the difference between "pos" and "pos1" to get which quarter we are dealing with
If ((strString(i + 1)) - strString(i)) > 1 And Not IsEmpty(strString(i + 1)) Then 'If the difference between cell "i +1" - cell "i" is larger than 1, and cell "i+1" is not empty, then..
Columns(i + 1).Resize(, ((strString(i + 1)) - strString(i)) - 1).Insert '... We use the difference between the cells and then resize our range which we want to insert
'### this part is only to create the header automatically, can be removed. ###
If ((strString(i + 1)) - strString(i)) > 2 Then 'If the difference is larger than 2, it means that we need to insert at least 2 columns or more
k = 1 'Set dummy variable k to 1
For j = i + 1 To strString(i) + (((strString(i + 1)) - strString(i)) - 1) 'Loop through the new empty inserted columns and add quarter headers
Cells(1, j).Value = "Q" & strString(i) + k & "<>"
k = k + 1 'Add one quarter
Next j
Else
Cells(1, i + 1).Value = "Q" & strString(i + 1) - ((strString(i + 1) - strString(i)) - 1) & "<>" 'Add Quarter headers if only one column was inserted
End If
'### --------------------------------------------------------------------- ###
End If
End If
Next i
End Sub
Final result:

Answer 3

you could avoid arrays:
Option Explicit
Sub Test()
Dim lCol As Long, i As Long
Dim qCurrent As Long, qPreceeding As Long
With Sheets(1) 'reference your sheet
lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column ' start from referenced sheet row 1 last not empty column index
Do While lCol > 1 ' start iterating from last column
If Left(.Cells(1, lCol).Value, 1) = "Q" Then
qCurrent = Val(Mid(.Cells(1, lCol).Value, 2)) ' get current column"Q" value
qPreceeding = Val(Mid(.Cells(1, lCol - 1).Value, 2)) ' get preceeding column"Q" value
If qCurrent > qPreceeding + 1 Then ' if current "Q" is not consecutive of preceeding one
.Cells(1, lCol).EntireColumn.Resize(, qCurrent - qPreceeding - 1).Insert ' insert columns
For i = 1 To qCurrent - qPreceeding - 1 'loop to recreate new headers
.Cells(1, lCol + i - 1).Value = "Q" & qPreceeding + i & "<>"
Next
End If
End If
lCol = lCol - 1 ' step backwards
Loop
End With
End Sub