-
This should do it. have changed how the array is sized and put in a loop for each character in populated cells.
[vba]Sub ReOrder_Cells()
Dim s1 As Worksheet, Cells_Used As Double, c As Range
Set s1 = Worksheets("Sheet1")
'set up array to hold new co-ordinates
Dim arr()
ReDim arr(1, 0)
'for each cell with value map row and new column(which is the value)
For Each c In s1.UsedRange.Cells
If c <> "" Then
'loop through each character
For j = 1 To Len(c.Value)
arr(0, UBound(arr, 2)) = c.Row
arr(1, UBound(arr, 2)) = Mid(c.Value, j, 1)
'increase arr size
ReDim Preserve arr(1, UBound(arr, 2) + 1)
Next j
End If
Next
'clear all old data
s1.Cells.Clear
'loop in new values (on error resume next to handle any values that are not Column names)
For i = 0 To UBound(arr, 2)
On Error Resume Next
s1.Cells(arr(0, i), CStr(arr(1, i))) = arr(1, i)
On Error GoTo 0
Next
End Sub[/vba]
-
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules