Sub rearrange()
'code to convert cotton cotton otda into colums by comma delimitted data
Call text_to_colum
'-------------------------------------------------------------------------------
'select data to trim the blank spaces
Dim LastRow2 As Long
With ActiveSheet
LastRow2 = .Cells(.Rows.Count, "a").End(xlUp).Row
End With
Range("a2", "m" & LastRow2).Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C"
'---------------------------------------------------------------------------------
'Insert a coloumn
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'add count a formula
Call put_counta_formula
' add no of rows as per cotton otda vailable in coloums
Range("a2").Select
Dim k As Long
Dim LastRow As Long
LastRow = Range("a" & Rows.Count).End(xlUp).Row
For k = 2 To LastRow
ActiveCell.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Dim i As Integer, n As Integer, m As Long
n = ActiveCell.Value - 1
m = ActiveCell.Row
If n <> 15 Then
Dim n1 As Integer
Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(n - 15, 0)).EntireRow.Insert ,
CopyOrigin:=xlFormatFromLeftOrAbove
Range(ActiveCell.Offset(0, 17), ActiveCell.Offset(0, n + 1)).Copy
ActiveCell.Offset(1, 16).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range(ActiveCell.Offset(-1, 1), ActiveCell.Offset(-1, n + 1)).ClearContents
ActiveCell.Offset(n - 15, -16).Select
Else
ActiveCell.Offset(1, 0).Select
End If
Next k
'Dim LastRow1 As Long
'Range("q2").Select
'Selection.SpecialCells(xlCellTypeLastCell).Select
Dim LastRow3 As Long
With ActiveSheet
LastRow3 = .Cells(.Rows.Count, "q").End(xlUp).Row
End With
Range("q2", "q" & LastRow3).Select
'--------------------------------------------------------------------------------
ActiveSheet.Columns("q").Replace _
What:=" ", _
Replacement:="", _
SearchOrder:=xlByColumns, _
MatchCase:=True
Range("b2", "p" & LastRow3).Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C"
End Sub
-----------------------------------------------------------------------------------
---------------------------
Sub put_counta_formula()
Range("A1").Select
Selection.SpecialCells(xlCellTypeLastCell).Select
Dim ColumnNumber As Long
Dim ColumnLetter As String
Dim lastcol
lastcol = ActiveCell.Column
ColumnNumber = lastcol
'Convert To Column Letter
ColumnLetter = Split(Cells(1, ColumnNumber).Address, "$")(1)
'
Dim strFormula As String
Dim cell As Range
Dim fromRow As Range, toRow As Range
Set cell = Range("a1")
' Directly assigning a String
cell.Formula = "=counta(b1:p1)"
' Storing string to a variable
' and assigning to "Formula" property
strFormula = "=counta(b1:p1)"
cell.Formula = strFormula
' Using variables to build a string
' and assigning it to "Formula" property
strFormula = "=counta(b1" & ":" & ColumnLetter & "1)"
cell.Formula = strFormula
Range("A1").Select
ActiveCell.Formula = cell.Formula
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "b").End(xlUp).Row
End With
Selection.AutoFill Destination:=Range("A1", "a" & LastRow)
End Sub
