Move data from multiple rows to columns

[msquared99]

I would greatly appreciate any help please.

I have a spreadsheet with the following data:

Column C - Name
Column F - Amount
Column G - Code #
Column H - Code Description

Issue: One person may have up to 3 entries with only the data in columns F-G changing.

How do I get VBA to take and put each unique value from a row and into a column?

Example:
One person has say 3 entries in the RawData tab. Instance 1 Col F = Term Life, Instance 2 Col F = Sp Life, Instance 3 Col F = Child Life

The macro would create the NewData tab and put instance 1 in Col Q-S Row 2, instance 2 in Col T-V Row 2 and instance 3 in Col W-Y Row 2 based on the column name. The uploaded example should help.

Thanks for anyone's help.

Mike

 

[Luke M]

I will say, your raw data is in a format that most people would probably prefer, as it's easier to put into PivotTables and/or charts. But, I suppose there's a good reason for it.

Here's the macro you could use:

Sub MoveData()
Dim sourceSheet As Worksheet
Dim destSheet As Worksheet
Dim curRow As Long, lastRow As Long
Dim i As Long
Dim fNumber As String
'Change these as needed
Set sourceSheet = Worksheets("RawData")
Set destSheet = Worksheets("Output")
Application.ScreenUpdating = False
fNumber = ""
'Where to start records, minus 1
curRow = 1
With sourceSheet
  lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
  
  For i = 2 To lastRow
  If fNumber <> .Cells(i, "A") Then
  'New name entry
  fNumber = .Cells(i, "A").Value
  curRow = curRow + 1
  
  'Transfer all static info
  .Range(.Cells(i, "A"), .Cells(i, "E")).Copy destSheet.Cells(curRow, "A")
  .Range(.Cells(i, "I"), .Cells(i, "S")).Copy destSheet.Cells(curRow, "F")
  End If
  
  'Transfer specific policy info
  'Note that we use UCase so that always compares Uppercase values
  Select Case UCase(.Cells(i, "H").Value)
  'Paste into a specific column based on which policy
  Case "TERM LIFE"
  .Range(.Cells(i, "F"), .Cells(i, "H")).Copy destSheet.Cells(curRow, "Q")
  Case "SP LIFE"
  .Range(.Cells(i, "F"), .Cells(i, "H")).Copy destSheet.Cells(curRow, "T")
  Case "CHILD LIFE"
  .Range(.Cells(i, "F"), .Cells(i, "H")).Copy destSheet.Cells(curRow, "S")
  Case Else
  'Do nothing, for now
  'Could add more if needed
  End Select
  Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[msquared99]

THANK YOU LUKE!!!!

You are a life saver man!

Mike

 

[Luke M]

You're very welcome Mike. Thanks for giving a good, detailed description of what you have, what you needed, and an example. Made writing the macro much easier.