Forum Discussion
Looking for excel Formula to Move multiple data to specific columns
- Aug 17, 2021
Formulas can return values from the referenced cells but they cannot move cell values. For that, you will need VBA.
Module1 in the attached contains the following code and contains a button called "Transpose Data" on Sheet1 which you may click to run the code and the code will transpose the data in the desired format.
Sub TransformData() Dim lr As Long Dim Rng As Range Dim RngArea As Range Dim arr As Variant Dim i As Long lr = Cells(Rows.Count, 1).End(xlUp).Row Application.ScreenUpdating = False On Error Resume Next Set RngArea = Range("A1:A" & lr).SpecialCells(xlCellTypeConstants, 2) On Error GoTo 0 If RngArea Is Nothing Then Exit Sub ReDim arr(1 To RngArea.Areas.Count, 1 To 3) For Each Rng In RngArea.Areas If Rng.Cells.Count = 3 Then i = i + 1 arr(i, 1) = Rng.Cells(1).Value arr(i, 2) = Rng.Cells(2).Value arr(i, 3) = Rng.Cells(2).Value End If Next Rng Columns(1).Clear Range("A2").Resize(UBound(arr, 1), 3).Value = arr ActiveSheet.UsedRange.Columns.AutoFit Application.ScreenUpdating = True End Sub
Formulas can return values from the referenced cells but they cannot move cell values. For that, you will need VBA.
Module1 in the attached contains the following code and contains a button called "Transpose Data" on Sheet1 which you may click to run the code and the code will transpose the data in the desired format.
Sub TransformData()
Dim lr As Long
Dim Rng As Range
Dim RngArea As Range
Dim arr As Variant
Dim i As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
On Error Resume Next
Set RngArea = Range("A1:A" & lr).SpecialCells(xlCellTypeConstants, 2)
On Error GoTo 0
If RngArea Is Nothing Then Exit Sub
ReDim arr(1 To RngArea.Areas.Count, 1 To 3)
For Each Rng In RngArea.Areas
If Rng.Cells.Count = 3 Then
i = i + 1
arr(i, 1) = Rng.Cells(1).Value
arr(i, 2) = Rng.Cells(2).Value
arr(i, 3) = Rng.Cells(2).Value
End If
Next Rng
Columns(1).Clear
Range("A2").Resize(UBound(arr, 1), 3).Value = arr
ActiveSheet.UsedRange.Columns.AutoFit
Application.ScreenUpdating = True
End Sub
- CherbptAug 17, 2021Copper Contributorwow ty so so much! Have an awesome day!
- Subodh_Tiwari_sktneerAug 17, 2021Silver Contributor
You're welcome Cherbpt! Glad it worked as desired.
Please take a minute to accept the post with the proposed solution as a Best Response to mark your question as Solved.