Thread: Extracting data from column based on specific criteria and pasting into new column

Hi everyone,

I've got a spreadsheet extracted from a timekeeping software. It gives me data in two columns:

Column A lists the associate's name, tasks, and activities per task.
Column B lists the hours entered for each.

For example:

Column A         Column B
Adams, Joe         800
 Task 1              400
  Activity A         200
  Activity B         200
Brown, Doug       600
 Task 2              300
  Activity A         150

However, this format is not very usable for the analysis I'd like to conduct. I can manually insert the appropriate associate's name in a new column, and do the same thing for the Task #, but that takes a great deal of time. I'm looking for some way to do this automatically. I'm thinking an if() function may be useful, and then recording a macro, but I can't seem to crack this nut.

Here's what I'd like it to look like:

Column A          Column B          Column C          Column D
Adams, Joe          Task 1           Activity A          200
Adams, Joe          Task 1           Activity B          200
Brown, Doug        Task 2           Activity A          150

I have two tabs on the attached spreadsheet, which is an example of the data I'm working with. The 'Currently' tab shows how the data is originally. The 'As Needed' tab shows how I'd like it to be, after some automated fashion.

Thanks in advance for your help!


test test.xls

This macro should do the work (see also attached file):

Public Sub test()
Dim C_ell As Range, N_ame As String, R_ow As Long
Dim T_ask As String, A_ctivity As String
N_ame = Range("A2")
T_hour = Range("D2")
R_ow = 0
For Each C_ell In Range("C2", Cells(Rows.Count, 3).End(xlUp))
If Asc(Left(C_ell, 1)) >= 65 Then 'start with a letter
  N_ame = C_ell
  Worksheets("As Needed").Range("A2").Offset(R_ow, 0) = N_ame
  Worksheets("As Needed").Range("A2").Offset(R_ow, 2) = N_ame
  Worksheets("As Needed").Range("A2").Offset(R_ow, 3) = C_ell.Offset(0, 1)
  R_ow = R_ow + 1
End If
If Len(C_ell) - Len(LTrim(C_ell)) = 6 Then
  T_ask = C_ell
  Worksheets("As Needed").Range("A2").Offset(R_ow, 0) = N_ame
  Worksheets("As Needed").Range("A2").Offset(R_ow, 1) = T_ask
  Worksheets("As Needed").Range("A2").Offset(R_ow, 2) = T_ask
  Worksheets("As Needed").Range("A2").Offset(R_ow, 3) = C_ell.Offset(0, 1)
  R_ow = R_ow + 1
End If
If Len(C_ell) - Len(LTrim(C_ell)) = 8 Then
  A_ctivity = C_ell
  Worksheets("As Needed").Range("A2").Offset(R_ow, 0) = N_ame
  Worksheets("As Needed").Range("A2").Offset(R_ow, 1) = T_ask
  Worksheets("As Needed").Range("A2").Offset(R_ow, 2) = A_ctivity
  Worksheets("As Needed").Range("A2").Offset(R_ow, 3) = C_ell.Offset(0, 1)
  R_ow = R_ow + 1
End If
Next
End Sub

Yep, that seems to do the trick!

Thanks so much for your help!!!