ashleyuk1984
06-10-2017, 04:29 PM
Hi,
I have a set of data that I would like to rearrange into a different format.
I've created a dummy spreadsheet showing a small section of the raw data, and also the desired result on a separate tab.
My current Macro will run on Sheet 3.
The data set is split into sections, by month.
So, the first section starts at January, then February, then March, then April ... And then next month the data set will include May, then June and so on.
http://i63.tinypic.com/14v5kaq.jpg
Within each month section, we have a bunch of companies.... and some of these are repeated every month, some are not. ABC might be in January / February and April (not March), and XYZ might only be in April.
http://i67.tinypic.com/23tnvi1.png
On the right hand side of the dataset, we have a bunch of 'codes'.
And this is the stuff that we need to use to sort out the companies.
http://i65.tinypic.com/30hrl35.png
This is what I'm trying to achieve.
http://i65.tinypic.com/dgl28p.png
But this is what I'm currently getting.
http://i63.tinypic.com/14qtso.png
All of my months are going on seperate rows, but I need to match the company name and code before placing the months. (so if it already exists, just place the month on that row, otherwise create a new record at the bottom)
I'm unsure of the best way to do it.
My complete data set is around 100,000 rows... So ideally, I need to avoid using loops on this amount of rows, otherwise it's going to take forever to complete :(
Here is my current code. It will also be in the attached file.
'########################################################################## ##
'###### DONT DELETE THE HEADINGS... THESE ARE SET UP IN THE MACRO YET #######
'########################################################################## ##
Sub SortData()
Dim Lastrow, x As Long
Dim MonthName As String
Dim CodeNumbers As Variant
'Get LastRow of Raw Data sheet
Lastrow = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
'Loop through Raw Data and sort it out into the desired format
For x = 2 To Lastrow
LastRowSheet3 = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row
MonthName = Sheets(1).Range("A" & x).Value
CompanyName = Sheets(1).Range("C" & x).Value
CodeNumbers = Sheets(1).Range("J" & x & ":CA" & x)
TestForCode = CodeNumbers(1, 1)
'1 to 70 because Column CA represents 70 (J = 1 ---> CA = 70)
For y = 1 To 70
If CodeNumbers(1, y) = Empty Then Exit For
Sheets(3).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = CompanyName
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = Application.Transpose(CodeNumbers(1, y))
If MonthName = "January" Then
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(0, 1).Value = MonthName
ElseIf MonthName = "February" Then
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(0, 2).Value = MonthName
ElseIf MonthName = "March" Then
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(0, 3).Value = MonthName
ElseIf MonthName = "April" Then
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(0, 4).Value = MonthName
ElseIf MonthName = "May" Then
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(0, 5).Value = MonthName
ElseIf MonthName = "June" Then
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(0, 6).Value = MonthName
ElseIf MonthName = "July" Then
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(0, 7).Value = MonthName
ElseIf MonthName = "August" Then
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(0, 8).Value = MonthName
ElseIf MonthName = "September" Then
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(0, 9).Value = MonthName
ElseIf MonthName = "October" Then
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(0, 10).Value = MonthName
ElseIf MonthName = "November" Then
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(0, 11).Value = MonthName
ElseIf MonthName = "December" Then
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(0, 12).Value = MonthName
End If
Next y
Next x
'Sort the data, first by Company Name, then by Code
Range("A1").CurrentRegion.Select
ActiveWorkbook.Worksheets("Macro Runs Here").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Macro Runs Here").AutoFilter.Sort.SortFields.Add Key:=Range("A2:A168"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Macro Runs Here").AutoFilter.Sort.SortFields.Add Key:=Range("B2:B168"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Macro Runs Here").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Here is the spreadsheet
19458
If all goes well, your results and the data on the "Desired Result" sheet should match.
Hope you can help.
Thanks
I have a set of data that I would like to rearrange into a different format.
I've created a dummy spreadsheet showing a small section of the raw data, and also the desired result on a separate tab.
My current Macro will run on Sheet 3.
The data set is split into sections, by month.
So, the first section starts at January, then February, then March, then April ... And then next month the data set will include May, then June and so on.
http://i63.tinypic.com/14v5kaq.jpg
Within each month section, we have a bunch of companies.... and some of these are repeated every month, some are not. ABC might be in January / February and April (not March), and XYZ might only be in April.
http://i67.tinypic.com/23tnvi1.png
On the right hand side of the dataset, we have a bunch of 'codes'.
And this is the stuff that we need to use to sort out the companies.
http://i65.tinypic.com/30hrl35.png
This is what I'm trying to achieve.
http://i65.tinypic.com/dgl28p.png
But this is what I'm currently getting.
http://i63.tinypic.com/14qtso.png
All of my months are going on seperate rows, but I need to match the company name and code before placing the months. (so if it already exists, just place the month on that row, otherwise create a new record at the bottom)
I'm unsure of the best way to do it.
My complete data set is around 100,000 rows... So ideally, I need to avoid using loops on this amount of rows, otherwise it's going to take forever to complete :(
Here is my current code. It will also be in the attached file.
'########################################################################## ##
'###### DONT DELETE THE HEADINGS... THESE ARE SET UP IN THE MACRO YET #######
'########################################################################## ##
Sub SortData()
Dim Lastrow, x As Long
Dim MonthName As String
Dim CodeNumbers As Variant
'Get LastRow of Raw Data sheet
Lastrow = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
'Loop through Raw Data and sort it out into the desired format
For x = 2 To Lastrow
LastRowSheet3 = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row
MonthName = Sheets(1).Range("A" & x).Value
CompanyName = Sheets(1).Range("C" & x).Value
CodeNumbers = Sheets(1).Range("J" & x & ":CA" & x)
TestForCode = CodeNumbers(1, 1)
'1 to 70 because Column CA represents 70 (J = 1 ---> CA = 70)
For y = 1 To 70
If CodeNumbers(1, y) = Empty Then Exit For
Sheets(3).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = CompanyName
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = Application.Transpose(CodeNumbers(1, y))
If MonthName = "January" Then
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(0, 1).Value = MonthName
ElseIf MonthName = "February" Then
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(0, 2).Value = MonthName
ElseIf MonthName = "March" Then
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(0, 3).Value = MonthName
ElseIf MonthName = "April" Then
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(0, 4).Value = MonthName
ElseIf MonthName = "May" Then
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(0, 5).Value = MonthName
ElseIf MonthName = "June" Then
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(0, 6).Value = MonthName
ElseIf MonthName = "July" Then
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(0, 7).Value = MonthName
ElseIf MonthName = "August" Then
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(0, 8).Value = MonthName
ElseIf MonthName = "September" Then
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(0, 9).Value = MonthName
ElseIf MonthName = "October" Then
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(0, 10).Value = MonthName
ElseIf MonthName = "November" Then
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(0, 11).Value = MonthName
ElseIf MonthName = "December" Then
Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(0, 12).Value = MonthName
End If
Next y
Next x
'Sort the data, first by Company Name, then by Code
Range("A1").CurrentRegion.Select
ActiveWorkbook.Worksheets("Macro Runs Here").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Macro Runs Here").AutoFilter.Sort.SortFields.Add Key:=Range("A2:A168"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Macro Runs Here").AutoFilter.Sort.SortFields.Add Key:=Range("B2:B168"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Macro Runs Here").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Here is the spreadsheet
19458
If all goes well, your results and the data on the "Desired Result" sheet should match.
Hope you can help.
Thanks