Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.
Option Explicit
Sub Trans()
Dim I As Long
Dim J As Long
Dim X As Long
Dim arrSrc
Dim arrDst
arrSrc = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
ReDim arrDst(1 To UBound(arrSrc), 1 To 1)
For I = 1 To UBound(arrSrc)
If IsNumeric(Left(arrSrc(I, 1), 2)) Then
X = X + 1
ReDim Preserve arrDst(1 To UBound(arrSrc), 1 To X)
J = 1
arrDst(J, X) = arrSrc(I, 1)
J = J + 1
Else
arrDst(J, X) = arrSrc(I, 1)
J = J + 1
End If
Next I
Range("B1").Resize(UBound(arrDst, 2), UBound(arrDst)).Value = Application.Transpose(arrDst)
End Sub
Sub Transposition()
Dim vData As Variant, vResults As Variant
Dim i As Long, j As Long, k As Long, n As Long, nCols As Long, nn As Long
Dim rg As Range
nCols = 5 'Maximum number of columns of data in a a record
With ActiveSheet
Set rg = .Range("A1") 'First cell with data
Set rg = Range(rg, .Cells(.Rows.Count, rg.Column).End(xlUp)) 'All the data in that column
End With
vData = rg.Value
n = rg.Rows.Count
nn = Int((n + nCols - 1) / nCols)
ReDim vResults(1 To n, 1 To nCols)
For i = 1 To n
If IsNumeric(Left(vData(i, 1), 2)) Then
k = k + 1
j = 1
Else
j = j + 1
End If
'vResults(k, j) = vData(i, 1) 'If you don't want empty rows between records
vResults(i - j + 1, j) = vData(i, 1) 'If you want empty rows between records
Next
rg.Cells(1, 2).Resize(n, nCols).Value = vResults 'Empty rows between records
'rg.Cells(1, 2).Resize(k, nCols).Value = vResults 'No empty rows between records
End Sub
If you are experiencing a similar issue, please ask a related question
Title | # Comments | Views | Activity |
---|---|---|---|
Excel formula needed | 7 | 19 | |
conditional formatting | 4 | 41 | |
Excel formula Sumif not working | 4 | 25 | |
VBA – How to copy a cell from one page and enter it into a new line on another page while selecting where the new line is added? | 7 | 19 |
Join the community of 500,000 technology professionals and ask your questions.
Connect with top rated Experts
11 Experts available now in Live!