Excel 2007 I need help with editing a macro that sorts a range of data and autop

Question

Excel 2007 I need help with editing a macro that sorts a range of data and autopopulates 5 columns but I would like it to expand to 27 columns

Hi, I am editing a macro in Excel 2007 that takes a range of data 5 columns wide and repopulates it into a new sheet with 5 columns where the values are reported from the original 5 columns but all the zeros and blanks are filtered out. What I would like to do is edit this macro so that it resorts just one column of that range (the second) across 27 categories that are coded in the first column. Ideally, the macro would repopulate 27 columns in a new sheet that show all of the values within each category, with zeros and blanks removed. Is this possible? Thank you very much, any assistance on this issue would be greatly appreciated. Here is the code as well that I currently have:

Sub SolutionsAreasButton()
'
' Macro22 Macro
'
Application.ScreenUpdating = False
Sheets("Business Assessment").Select
Range("V57:AA93").Select
Selection.Copy
Sheets("Solutions Areas").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.SpecialCells(xlCellTypeBlanks).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeConstants, 1).Select
Selection.Delete Shift:=xlUp
Columns("B:F").Select
Columns("B:F").EntireColumn.AutoFit
Columns("B:B").Select
ActiveSheet.Range("B:B").RemoveDuplicates Columns:=1, Header:=xlNo
'Alphabetize
Range("B2:B75").Select
ActiveWorkbook.Worksheets("Solutions Areas").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Solutions Areas").Sort.SortFields.Add Key:=Range("B2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Solutions Areas").Sort
.SetRange Range("B2:B75")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("C:C").Select
ActiveSheet.Range("C:C").RemoveDuplicates Columns:=1, Header:=xlNo
'Alphabetize
Range("C2:C75").Select
ActiveWorkbook.Worksheets("Solutions Areas").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Solutions Areas").Sort.SortFields.Add Key:=Range("C2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Solutions Areas").Sort
.SetRange Range("C2:C75")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("D:D").Select
ActiveSheet.Range("D:D").RemoveDuplicates Columns:=1, Header:=xlNo
'Alphabetize
Range("D2:D75").Select
ActiveWorkbook.Worksheets("Solutions Areas").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Solutions Areas").Sort.SortFields.Add Key:=Range("D2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Solutions Areas").Sort
.SetRange Range("D2:D75")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("E:E").Select
ActiveSheet.Range("E:E").RemoveDuplicates Columns:=1, Header:=xlNo
'Alphabetize
Range("E2:E75").Select
ActiveWorkbook.Worksheets("Solutions Areas").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Solutions Areas").Sort.SortFields.Add Key:=Range("E2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Solutions Areas").Sort
.SetRange Range("E2:E75")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("F:F").Select
ActiveSheet.Range("F:F").RemoveDuplicates Columns:=1, Header:=xlNo
'Alphabetize
Range("F2:F75").Select
ActiveWorkbook.Worksheets("Solutions Areas").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Solutions Areas").Sort.SortFields.Add Key:=Range("F2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Solutions Areas").Sort
.SetRange Range("F2:F75")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

Explanation / Answer

I am not sure of your question. But you may prefer to use the below shorter code. The below code Filters out 0 and blanks from Sheet1 >> Re-Pastes the same into Sheet2 (second sheet, should be a blank one) with blanks and 0 filtered out:

Sub CopyFilteredRange()

Dim Rng As Range
Set Rng = Worksheets(1).Range("A1").CurrentRegion

If Worksheets(1).AutoFilterMode = True Then
Rng.AutoFilter
Else
Rng.AutoFilter Field:=1, Criteria1:="<>0" ' - Column1 assumed a number column to filter out 0
Rng.AutoFilter Field:=2, Criteria1:="<>" ' - Column2 assumed a text column to filter out blanks
End If

Worksheets(1).AutoFilter.Range.Copy
Worksheets(2).Activate
Worksheets(2).Range("A1").PasteSpecial xlPasteAll

End Sub

You may alter the code to appropriately mark the column having text values (for excluding blanks) and numeric values (for excluding 0)

Related Questions

Navigate

• Browse (All)
• Browse E
• Subjects

Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.