Forum Discussion
Excel macro help - cutting off first letter of some results in pivot
- Dec 15, 2023
matthewwwood The most likely culprit is the use of the Mid function to exclude the leading character(s) from columns 2 and 3:
' Split phrases in column 2 and copy corresponding data For i = 2 To LastRow phrases1 = Split(Mid(rootData.Cells(i, 2).value, 2), ",") ... ' Split phrases in column 3 and copy corresponding data For i = 2 To LastRow phrases2 = Split(Mid(rootData.Cells(i, 3).value, 3), ",")For column 2, the Start position is 2, but for column 3 the Start position is 3. Is this a typo? Should it be 2 for both? If not, then...
Do all of the cells in columns 2 and 3 contain the same number of leading character(s) that you are trying to exclude? I would start by examining the source data... locate the cell that contains "microgrids" and verify that it follows the same pattern as the other cells regarding leading characters.
Sub SplitPhrases()
Dim rootData As Worksheet
Dim newData1 As Worksheet
Dim newData2 As Worksheet
Dim LastRow As Long
Dim i As Long, j As Long
Dim phrases1() As String
Dim phrases2() As String
RemoveSheets
' Set the worksheets
Set rootData = ThisWorkbook.Worksheets("Root Data")
Set newData1 = ThisWorkbook.Worksheets.Add(After:=rootData)
Set newData2 = ThisWorkbook.Worksheets.Add(After:=newData1)
' Set names for new sheets
newData1.Name = rootData.Cells(1, 2).value
newData2.Name = rootData.Cells(1, 3).value
' Find the last row in root data
LastRow = rootData.Cells(rootData.Rows.Count, 2).End(xlUp).Row
' Split phrases in column 2 and copy corresponding data
For i = 2 To LastRow
phrases1 = Split(Mid(rootData.Cells(i, 2).value, 2), ",")
For j = 0 To UBound(phrases1)
newData1.Cells(newData1.Rows.Count, 1).End(xlUp).Offset(1, 0).value = rootData.Cells(i, 1).value
newData1.Cells(newData1.Rows.Count, 2).End(xlUp).Offset(1, 0).value = phrases1(j)
newData1.Cells(newData1.Rows.Count, 3).End(xlUp).Offset(1, 0).value = rootData.Cells(i, 4).value
newData1.Cells(newData1.Rows.Count, 4).End(xlUp).Offset(1, 0).value = rootData.Cells(i, 5).value
Next j
Next i
' Split phrases in column 3 and copy corresponding data
For i = 2 To LastRow
phrases2 = Split(Mid(rootData.Cells(i, 3).value, 3), ",")
For j = 0 To UBound(phrases2)
newData2.Cells(newData2.Rows.Count, 1).End(xlUp).Offset(1, 0).value = rootData.Cells(i, 1).value
newData2.Cells(newData2.Rows.Count, 2).End(xlUp).Offset(1, 0).value = phrases2(j)
newData2.Cells(newData2.Rows.Count, 3).End(xlUp).Offset(1, 0).value = rootData.Cells(i, 4).value
newData2.Cells(newData2.Rows.Count, 4).End(xlUp).Offset(1, 0).value = rootData.Cells(i, 5).value
Next j
Next i
' Rename headers in Sheet 2
newData1.Cells(1, 1).value = rootData.Cells(1, 1).value
newData1.Cells(1, 2).value = rootData.Cells(1, 2).value
newData1.Cells(1, 3).value = rootData.Cells(1, 4).value
newData1.Cells(1, 4).value = rootData.Cells(1, 5).value
' Rename headers in Sheet 3
newData2.Cells(1, 1).value = rootData.Cells(1, 1).value
newData2.Cells(1, 2).value = rootData.Cells(1, 3).value
newData2.Cells(1, 3).value = rootData.Cells(1, 4).value
newData2.Cells(1, 4).value = rootData.Cells(1, 5).value
' Autofit columns in new sheets
newData1.Columns.AutoFit
newData2.Columns.AutoFit
RemoveQuotationMarks
CreatePivotTableHigh
CreatePivotTableMedium
HideSheets
End Sub
Sub RemoveQuotationMarks()
Sheets("Intent_Keywords_High_Strength").Activate
Columns("B:B").Select
Selection.Replace What:="""", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Sheets("Intent_Keywords_Medium_Strength").Activate
Columns("B:B").Select
Selection.Replace What:="""", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Sub CreatePivotTableHigh()
Dim wsData As Worksheet
Dim wsPivot As Worksheet
Dim rngData As Range
Dim pivotTable As pivotTable
Dim pivotRange As Range
Dim pvtRange As Range
Dim lastColumn As Range
' Set references to the data sheet and pivot sheet
Set wsData = ThisWorkbook.Sheets("Intent_Keywords_High_Strength")
Set wsPivot = ThisWorkbook.Sheets.Add(After:=wsData)
' Define the range of data for the pivot table
Set rngData = wsData.Range("A1").CurrentRegion
' Create the pivot table on the pivot sheet
Set pivotRange = wsPivot.Range("A1")
Set pivotTable = wsPivot.PivotTableWizard( _
SourceType:=xlDatabase, _
SourceData:=rngData, _
TableDestination:=pivotRange, _
TableName:="PivotTable1")
' Set the pivot table fields
With pivotTable
.PivotFields("Intent_Keywords_High_Strength").Orientation = xlRowField
.PivotFields("Intent_Keywords_High_Strength").Orientation = xlDataField
.PivotFields("Domain").Orientation = xlPageField
.PivotFields("Intent_Keywords_High_Strength").AutoSort xlDescending, _
"Count of Intent_Keywords_High_Strength", ActiveSheet.PivotTables("PivotTable1" _
).PivotColumnAxis.PivotLines(1), 1
End With
' Format the pivot table as needed
ActiveSheet.PivotTables("PivotTable1").TableStyle2 = "PivotStyleDark7"
ActiveWindow.DisplayGridlines = False
' Refresh the pivot table
pivotTable.RefreshTable
' Set names for pivot sheets
ActiveSheet.Name = "HS_Pivot"
End Sub
Sub CreatePivotTableMedium()
Dim wsData As Worksheet
Dim wsPivot As Worksheet
Dim rngData As Range
Dim pivotTableM As pivotTable
Dim pivotRange As Range
Dim pvtRange As Range
Dim lastColumn As Range
' Set references to the data sheet and pivot sheet
Set wsData = ThisWorkbook.Sheets("Intent_Keywords_Medium_Strength")
Set wsPivot = ThisWorkbook.Sheets.Add(After:=wsData)
' Define the range of data for the pivot table
Set rngData = wsData.Range("A1").CurrentRegion
' Create the pivot table on the pivot sheet
Set pivotRange = wsPivot.Range("A1")
Set pivotTableM = wsPivot.PivotTableWizard( _
SourceType:=xlDatabase, _
SourceData:=rngData, _
TableDestination:=pivotRange, _
TableName:="PivotTable2")
' Set the pivot table fields
With pivotTableM
.PivotFields("Intent_Keywords_Medium_Strength").Orientation = xlRowField
.PivotFields("Intent_Keywords_Medium_Strength").Orientation = xlDataField
.PivotFields("Domain").Orientation = xlPageField
End With
' Sort Table
Range("B5").Select
ActiveSheet.PivotTables("PivotTable2").PivotFields( _
"Intent_Keywords_Medium_Strength").AutoSort xlDescending, _
"Count of Intent_Keywords_Medium_Strength", ActiveSheet.PivotTables( _
"PivotTable2").PivotColumnAxis.PivotLines(1), 1
' Format the pivot table as needed
ActiveSheet.PivotTables("PivotTable2").TableStyle2 = "PivotStyleDark5"
ActiveWindow.DisplayGridlines = False
' Refresh the pivot table
pivotTableM.RefreshTable
' Set names for pivot sheets
ActiveSheet.Name = "MS_Pivot"
End Sub
Sub RemoveSheets()
Dim ws As Worksheet
Dim sheetNames() As Variant
Dim i As Long
' Define the sheet names to be removed
sheetNames = Array("Intent_Keywords_Medium_Strength", "Intent_Keywords_High_Strength", "HS_Pivot", "MS_Pivot")
Application.DisplayAlerts = False ' Disable alert messages
' Loop through each sheet in the workbook in reverse order
For i = ThisWorkbook.Worksheets.Count To 1 Step -1
Set ws = ThisWorkbook.Worksheets(i)
' Check if the sheet name matches any of the specified names
If IsInArray(ws.Name, sheetNames) Then
Application.DisplayAlerts = False ' Disable alert messages
ws.Delete ' Delete the sheet
Application.DisplayAlerts = True ' Enable alert messages
End If
Next i
Application.DisplayAlerts = True ' Enable alert messages
End Sub
Function IsInArray(value As Variant, arr As Variant) As Boolean
' Check if a value exists in an array
Dim element As Variant
On Error Resume Next
element = Application.Match(value, arr, 0)
On Error GoTo 0
IsInArray = Not IsError(element)
End Function
Sub HideSheets()
Dim ws As Worksheet
On Error Resume Next ' Ignore errors if sheet doesn't exist
' Hide "Intent_Keywords_Medium_Strength" sheet
Set ws = ThisWorkbook.Sheets("Intent_Keywords_Medium_Strength")
If Not ws Is Nothing Then
ws.Visible = xlSheetHidden
End If
' Hide "Intent_Keywords_High_Strength" sheet
Set ws = ThisWorkbook.Sheets("Intent_Keywords_High_Strength")
If Not ws Is Nothing Then
ws.Visible = xlSheetHidden
End If
On Error GoTo 0 ' Reset error handling
End Subdjclements - thanks for the tip! Let me know if this is doable?
matthewwwood The most likely culprit is the use of the Mid function to exclude the leading character(s) from columns 2 and 3:
' Split phrases in column 2 and copy corresponding data
For i = 2 To LastRow
phrases1 = Split(Mid(rootData.Cells(i, 2).value, 2), ",")
...
' Split phrases in column 3 and copy corresponding data
For i = 2 To LastRow
phrases2 = Split(Mid(rootData.Cells(i, 3).value, 3), ",")
For column 2, the Start position is 2, but for column 3 the Start position is 3. Is this a typo? Should it be 2 for both? If not, then...
Do all of the cells in columns 2 and 3 contain the same number of leading character(s) that you are trying to exclude? I would start by examining the source data... locate the cell that contains "microgrids" and verify that it follows the same pattern as the other cells regarding leading characters.