Post an example worksheet with examples of the base data and how you would like it to be sorted.
The tasks I need to do in Excel today are just are a bit more taxing than usual. Hence, the flood of questions apologies.
I have started to write a macro to automate a component of the task I need to do repetitively for the next couple of weeks. So, it is an exercise for myself as well to learn more code for future tasks.
My source data is in the Base_Data worksheet within the Source.xlsx workbook. This worksheet has multiple columns of which some are not necessary for the analysis/macro. I would like the macro to copy the relevant data from this source data worksheet into new worksheets of Output.xlsx workbook based on the headers (these are manually copied and pasted in by myself). However, the issue is that the source data was one huge horrific spreadsheet with multiple entities in the same column. I need these entities to be split out into different worksheets in this new Output.xlsx workbook during this copying and pasting task. These entities are all in column B. For instance, there are entities such as Table, Chairs, Stairs etc. in the Base_Data worksheet. I need these to be split out into separate Table and Chairs and Stairs etc. worksheets in the Output.xlsx workbook.
The necessary columns for each worksheet are to copy and paste from the source column into the target column as follows:
Source Column .Target Column
I know this might be a difficult piece of code to write up (well, it is for me!!), and take some of your precious time, so lots of thanks for any help received but I am sure this will be of immense assistance for me in learning more VBA.
I have attached the first couple of lines of the original data (Source) and also the results I would like when the macro has finished running (Output). I have also commented a few cells as well.
Once again thanks for your time into this matter Much appreciated!
Hope this is of use to you!
Code:Option Explicit Sub sort_data() 'This routine sorts the data into different worksheets in a separate workbook based its VIRTUAL_STRATEGY_ID value Dim spart As Range Dim outputbook, sourcebook As Workbook Dim numrows, nostrategytypes, i, k As Double 'Firstly creating new worksheet Set sourcebook = ActiveWorkbook Set outputbook = Workbooks.Add outputbook.SaveAs , Filename:="OUTPUT.xls" 'Counting the number of data rows in source sheet sourcebook.Activate numrows = Sheet1.Cells(1, 1).End(xlDown).Row Range(Sheet1.Cells(1, 2), Sheet1.Cells(numrows, 2)).AdvancedFilter xlFilterCopy, copytorange:=Sheet2.Cells(1, 1), unique:=True nostrategytypes = Sheet2.Cells(1, 1).End(xlDown).Row - 1 'Adding in new worksheets and copying over data If outputbook.Worksheets.Count < nostrategytypes Then outputbook.Worksheets.Add Count:=(nostrategytypes - outputbook.Worksheets.Count) End If 'Adding in new worksheets and copying over data For Each spart In Range(Sheet2.Cells(2, 1), Sheet2.Cells(nostrategytypes + 1, 1)) k = 2 outputbook.Worksheets(spart.Row - 1).Name = spart Range(Sheet1.Cells(1, 1), Sheet1.Cells(1, 17)).Copy Destination:=outputbook.Worksheets(spart.Row - 1).Cells(1, 1) For i = 2 To numrows If spart = Sheet1.Cells(i, 2) Then Range(Sheet1.Cells(i, 1), Sheet1.Cells(i, 17)).Copy Destination:=outputbook.Worksheets(spart.Row - 1).Cells(k, 1) k = k + 1 End If Next i 'Now adding in blank columns outputbook.Worksheets(spart.Row - 1).Columns(2).Insert outputbook.Worksheets(spart.Row - 1).Columns(6).Insert outputbook.Worksheets(spart.Row - 1).Columns(12).Insert Next spart 'Clearing temporary data sourcebook.Activate Sheet2.Cells.ClearContents End Sub
Thank you for your time spent on coding this up. Also I am really grateful that you have commented out the code with each step so that I could understand it; as some previous users just gave me the macro with no explanations. I have learnt lots of new syntax and methods to change the object properties from your code!
I have one further question that has now come up (but not to do with your code), which I dont really understand and gives me the subscript out of range error box popping up.
After this sorting macro completes, I need to copy and paste the newly sorted out data into a new workbook. So, at the end of your code (but before the End Sub), I added this:
I have also tried (which is a shorter way that I learnt from this guidebook through specifying an argument for the copy procedure):Code:Application.Calculation = xlManual ''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim analysisbook As Workbook '''''''''''''''''''''''''''''''' 'Create another new workbook where analysis will be performed Set analysisbook = Workbooks.Add analysisbook.SaveAs Filename:="Analysis" & " " & Format(Now(), "mm_dd_yyyy_hh_mm_AMPM" & ".xlsx") outputbook.Activate Worksheets("Tables").Columns("A:R").Select Selection.Copy analysisbook.Worksheets("Sheet 1").Range("A1").Select ActiveSheet.Paste End Sub
Code:outputbook.Activate Worksheets("Tables").Columns("A:R").Copy analysisbook.Worksheets("Sheet 1").Range("A1") End Sub
I dont know what is wrong as I have already declared this new analysisbook variable.
Once again, you were really helpful
There are currently 1 users browsing this thread. (0 members and 1 guests)