Excel Data Organizing - Tough

[TheAddis]

The Data I have - extracted (about 80+ columns for different people and about 150 rows for the codes):

Contribution Site Codes	Person-A	Person-B	Person-C	Person-D
001-5500-000-55	50%​		50%​
003-6600-000-56	20%​	40%​	20%​	10%​
002-8800-000-57		20%​	30%​
001-0677-000-58	30%​	40%​		90%​
Total From Each Person	100%​	100%​	100%​	100%​

The way I wanted to see the Data at the end (By each person only for the sites that there is data for. I do not want to see the zeros/blanks).

Person-A
001-5500-000-55	50%​
003-6600-000-56	20%​
001-0677-000-58	30%​
	100%​
Person-B
003-6600-000-56	40%​
002-8800-000-57	20%​
001-0677-000-58	40%​
	100%​
Person-C
001-5500-000-55	50%​
003-6600-000-56	20%​
002-8800-000-57	30%​
	100%​
Person-D
003-6600-000-56	10%​
001-0677-000-58	90%​
	100%​

Your help will save me a day work to may be an hour or even less. Thanks.

 

[TheAddis]

Please see the image:

 

[Rick Rothstein]

Give this macro a try...

Sub ContributionSiteData()
  Dim R As Long, C As Long, LastRow As Long, LastCol As Long, Sites As Range
  Set Sites = Range("A2", Cells(Rows.Count, "A").End(xlUp).Offset(-1))
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
  On Error GoTo Oops
  Application.ScreenUpdating = False
  For C = 2 To LastCol
    With Cells(Rows.Count, "A").End(xlUp)
      .Offset(2).Value = Cells(1, C).Value
      .Offset(3).Resize(Sites.Rows.Count).Value = Sites.Value
      .Offset(3, 1).Resize(Sites.Rows.Count).Value = Sites.Offset(, C - 1).Value
      .Offset(3 + Sites.Rows.Count, 1).Value = Cells(LastRow, C).Value
      .Offset(3, 1).Resize(Sites.Rows.Count + 1).NumberFormat = "0%"
      .Offset(3, 1).Resize(Sites.Rows.Count).Replace "", "#N/A", xlWhole, , , , False, False
    End With
  Next
  Columns("B").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
Oops:
  Application.ScreenUpdating = True
End Sub

 

[TheAddis]

Give this macro a try...

Sub ContributionSiteData()
  Dim R As Long, C As Long, LastRow As Long, LastCol As Long, Sites As Range
  Set Sites = Range("A2", Cells(Rows.Count, "A").End(xlUp).Offset(-1))
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
  On Error GoTo Oops
  Application.ScreenUpdating = False
  For C = 2 To LastCol
    With Cells(Rows.Count, "A").End(xlUp)
      .Offset(2).Value = Cells(1, C).Value
      .Offset(3).Resize(Sites.Rows.Count).Value = Sites.Value
      .Offset(3, 1).Resize(Sites.Rows.Count).Value = Sites.Offset(, C - 1).Value
      .Offset(3 + Sites.Rows.Count, 1).Value = Cells(LastRow, C).Value
      .Offset(3, 1).Resize(Sites.Rows.Count + 1).NumberFormat = "0%"
      .Offset(3, 1).Resize(Sites.Rows.Count).Replace "", "#N/A", xlWhole, , , , False, False
    End With
  Next
  Columns("B").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
Oops:
  Application.ScreenUpdating = True
End Sub

@Rick Rothstein You are a STAR! I just put the code and it does the majic!! Thank you so - so much!!

 

[DanteAmor]

Welcome to the MrExcel Message Board!

Here is another macro for you to consider.

Sub Data_Organizing()
  Dim c As Range, lr As Long
  lr = Range("A" & Rows.Count).End(3).Row - 2
  For Each c In Range("B1", Cells(1, Columns.Count).End(1))
    c.Copy Range("A" & Rows.Count).End(3)(3)
    Union(c.Offset(1).Resize(lr).SpecialCells(2), c.Offset(1).Resize(lr).SpecialCells(2).Offset(, 1 - c.Column)).Copy Range("A" & Rows.Count).End(3)(2)
  Next
End Sub

 

[TheAddis]

Welcome to the MrExcel Message Board!

Here is another macro for you to consider.

Sub Data_Organizing()
  Dim c As Range, lr As Long
  lr = Range("A" & Rows.Count).End(3).Row - 2
  For Each c In Range("B1", Cells(1, Columns.Count).End(1))
    c.Copy Range("A" & Rows.Count).End(3)(3)
    Union(c.Offset(1).Resize(lr).SpecialCells(2), c.Offset(1).Resize(lr).SpecialCells(2).Offset(, 1 - c.Column)).Copy Range("A" & Rows.Count).End(3)(2)
  Next
End Sub

@DanteAmor You are amazing! Your code worked perfectly. I can't believe such a short clean code does the whole big spreadsheet that fast and clean!! Thank you so much!!

 

[TheAddis]

@DanteAmor You are amazing! Your code worked perfectly. I can't believe such a short clean code does the whole big spreadsheet that fast and clean!! Thank you so much!!

Hi @DanteAmor ... While reviewing the whole content, I just noticed that running that code doesn't pick up the very last row (site code) and the value that has one value for one person. Will that be something you can fix in the code you provide? If that helps, the code @Rick Rothstein provided me picks up just the site code but not the amount for the very last row. Everything else is perfect. Thank you both!

 

[Rick Rothstein]

If that helps, the code @Rick Rothstein provided me picks up just the site code but not the amount for the very last row.

What amount for the very last row is my code not picking up? As far as I can tell by looking at your postings, my code has returned everything you showed you wanted. What is it that you think I missed?

 

[TheAddis]

What amount for the very last row is my code not picking up? As far as I can tell by looking at your postings, my code has returned everything you showed you wanted. What is it that you think I missed?

Hi @Rick Rothstein .. I can't share the actual document but this is what happened. My actual data covers 148 rows (A1 being title "Contribution Site Codes" and A2 through A148 the codes (all unique). The Columns extend upto column CE. Your Code picks everything as planned except the Contribution Site Code that is in the very last row (i.e. cell A148). However it picks the percentage for the correct person (this percentage is under on cell CB148, if that helps). Your code is still valid except missing this one last code but picking the person and the rate. Thanks.

 

[DanteAmor]

While reviewing the whole content, I just noticed that running that code doesn't pick up the very last row (site code) and the value that has one value for one person.

You could put an image of that part of the sheet.
Or better yet, you could sample your data using the XL2BB tool minisheets, replace your data with generic data.

Check that all the data has its heading in row 1.

___