I have an Excel sheet which contains following content:
I have worked on VBA code which does following:-
- Find the column having Header ABC
- Insert two new columns adjacent to ABC with name of AAA and BBB
- Then split the ABC cell content into respective cells of AAA and BBB; note (ABC column may have one one line in some cases )
- Follow step (3) till end of column ABC content.
End result should look like this:
I have written following code :-
Sub Num()
Dim rngDHeader As Range
Dim rngHeaders As Range
Set rngHeaders = Range("1:1") 'Looks in entire first row; adjust as needed.
Set rngDHeader = rngHeaders.Find("ABC")
Sub sbInsertingColumns()
'Inserting a Column at Column B
rngDHeader.EntireColumn.Insert
'Inserting 2 Columns from C
rngDHeader.EntireColumn.Insert
Dim rngDHeader As Range
Dim sText As String
Dim aText As Variant 'array
Dim i As Long 'number of array elements
Set rngDHeader = Sheets("Sheet1").Range("C2")
Do Until rng = ""
'split the text on carriage return character chr(10)
aText = Split(rngDHeader.Value, Chr(10))
'get the number of array elements
i = UBound(aText)
'build the output text string
sText = aText(i - 2) & Chr(10) _
& aText(i - 1) & Chr(10) _
& aText(i)
'output
rngDHeader.Offset(, 1) = sText
Set rngDHeader = rngDHeader.Offset(1, 0)
Loop
Set rngDHeader = Nothing
End Sub
Can anyone help me with this?
Numbered as per your question:
1.Find the Column having Header ABC
Dim colNum as Integer
colNum = ActiveSheet.Rows(1).Find(what:="ABC", lookat:=xlWhole).Column
2.Insert Two new Column Adjacent to ABC with Name of AAA and BBB
' Done twice to insert 2 new cols
ActiveSheet.Columns(colNum + 1).Insert
ActiveSheet.Columns(colNum + 1).Insert
' New col headings
ActiveSheet.Cells(1, colNum + 1).Value = "AAA"
ActiveSheet.Cells(1, colNum + 2).Value = "BBB"
3.Then Split the ABC cell content into respective AAA and BBB; note (ABC column may have one one line in some cases )
and
4.Follow the process till end of column ABC content.
' Define the range to iterate over as the used range of the found column
Dim colRange as Range
With ActiveSheet
Set colRange = .Range(.Cells(2, colNum), .Cells(.UsedRange.Rows.Count, colNum))
End With
Dim splitStr() as String
Dim vcell as Range
For Each vcell in colRange
' Create an array by splitting on the line break
splitStr = Split(vcell.value, Chr(10))
' Assign first new column as first array value.
ActiveSheet.Cells(vcell.row, colNum + 1).Value = splitStr(0)
' Assign second new column as second array value.
' First test if there *is* a second array value
If UBound(splitStr) > 0 Then
ActiveSheet.Cells(vcell.row, colNum + 2).Value = splitStr(1)
End If
Next vcell
Tags: excelexcel, vba