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
- Spell number in excel without macro - Guide
- Macro excel download - Download - Spreadsheets
- Excel macro to create new sheet based on value in cells - Guide
- Run macro on opening workbook - Guide
- Blinking cell in excel without macro - MacOS Forum
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