Macro: Group ColA with ColB results
Closed
pickforc
Posts
1
Registration date
Thursday April 8, 2010
Status
Member
Last seen
April 8, 2010
-
Apr 8, 2010 at 09:59 AM
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 - Apr 8, 2010 at 04:30 PM
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 - Apr 8, 2010 at 04:30 PM
Related:
- Macro: Group ColA with ColB results
- Excel online macro - Guide
- Excel run macro on open - Guide
- Macro for number to words in excel - Guide
- Excel macro download - Download - Spreadsheets
- How to copy macro from one workbook to another - Guide
1 response
rizvisa1
Posts
4478
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
766
Apr 8, 2010 at 04:30 PM
Apr 8, 2010 at 04:30 PM
Objective:
To consolidate the data by grouping a column and transposing its corresponding values across various column in one row.
Assumptions:
1. The data is on sheet1
2. The data to be grouped is in column A
3. The data that is to transposed or moved across various columns is in B
4. Columns after column B are available
Steps:
1. Read the Assumptions
2. Make a back up copy
3. Press ALT + F11 to get into VBE and insert a new module
4. Paste the code below in the module
Code:
To consolidate the data by grouping a column and transposing its corresponding values across various column in one row.
Assumptions:
1. The data is on sheet1
2. The data to be grouped is in column A
3. The data that is to transposed or moved across various columns is in B
4. Columns after column B are available
Steps:
1. Read the Assumptions
2. Make a back up copy
3. Press ALT + F11 to get into VBE and insert a new module
4. Paste the code below in the module
Code:
Sub transposeSpecial()
Dim dataSheet As String
Dim lMaxRows As Long
Dim currRow As Long
Dim temp As String
dataSheet = "Sheet1"
Sheets(dataSheet).Select
If ActiveSheet.AutoFilterMode Then
Cells.Select
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
End If
lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
currRow = 2
Do While Cells(currRow, "A") <> ""
temp = Cells(currRow, "A")
If ActiveSheet.AutoFilterMode = False Then
Cells.Select
Selection.AutoFilter
End If
Selection.AutoFilter Field:=1, Criteria1:="=" & temp
lMaxRows = Cells(Rows.Count, "B").End(xlUp).Row
If lMaxRows > 1 Then
Range("B" & (currRow + 1) & ":B" & lMaxRows).Copy
Range("C" & currRow).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Rows(currRow + 1 & ":" & lMaxRows).Delete
End If
currRow = currRow + 1
Loop
If ActiveSheet.AutoFilterMode = False Then
Cells.Select
Selection.AutoFilter
End If
End Sub
