macro adjustment help

psrs0810

Well-known Member
Joined
Apr 14, 2009
Messages
1,109
I utilize the macro below to take a single sheet of data and breakout information based on a specific column. In this case column D.
I use the macro for many different worksheets and the information I want to breakout is not always in column D.
What I would like to do is change it so that the range of data is selected with an input box and the data to break apart is also by an input box.
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p> </o:p>
So when I run it, the macro will ask me the range of the data, which I will enter. Then the next input box would ask what column I want to break out the data.

Sub test()
Application.ScreenUpdating = False
Dim i As Range, LR As Long, ws As Worksheet, wb As Workbook, C As Range
LR = Range("A" & Rows.Count).End(xlUp).Row
Sheets("sheet1").Range("d1:d" & LR).AdvancedFilter xlFilterCopy, copytorange:=Range("h1"), unique:=True
For Each C In Range("h2:h" & Range("h" & Rows.Count).End(xlUp).Row)
On Error GoTo 1
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = C.Value
Next C
1
For Each C In Sheets("sheet1").Range("h2:h" & Sheets("sheet1").Range("h" & Rows.Count).End(xlUp).Row)
Sheets("sheet1").Range("a1:d1").AutoFilter field:=4, Criteria1:=C.Value
Sheets("sheet1").Range("a1:d" & Sheets("sheet1").Range("a" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy
For Each ws In ThisWorkbook.Worksheets
If ws.Name = C.Value Then
ws.Range("a1").PasteSpecial xlPasteColumnWidths
ws.Range("a1").PasteSpecial xlValue
ws.Range("a1").PasteSpecial xlPasteFormats

End If
Next ws
Sheets("sheet1").Range("a1:d1").AutoFilter
Application.CutCopyMode = False
Next C
Sheets("sheet1").Columns("h").Delete
Sheets("sheet1").Select
Application.ScreenUpdating = True
End Sub
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

Forum statistics

Threads
1,224,586
Messages
6,179,722
Members
452,939
Latest member
WCrawford

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top