Stuck on how to Reformat data blocks into list with only essential data

**bnasty** · 10-27-2012, 11:04 AM

excelcutout.jpg

I need to format the above to look like this:

excelcutout2.jpg

The list is very long with it formatted like this. I need one column with the dollar amount and the adjacent column with the name and for it to repeat all the way down the list. Note some addresses have 2 lines.

How can I do this? I'm trying to learn excel macros but am stuck here...

Thanks for the reply!

**event21** · 10-27-2012, 11:15 AM

Hi-

If the format is always like that, then willwork (untested) as I wrote in a text file;

sub test()
with columns(1)
	set c=.find(":",,,1)
		if not c is nothing then
			f=c.address
			do
				sheets(2).cells(sheets(2).rows.count,1).end(xlup).offset(1).resize(,2).value=array(c.offset(,1).value,c.offset(4).value)
			set c=.findnext(c)
			loop until f=c.address
		end if
end with
end sub

Regards,
event

**mike7952** · 10-27-2012, 11:19 AM

Give this a try

Sub abc()
Dim FoundCell As Range
Dim LastCell As Range
Dim FirstAddr As String
Dim aData, n As Long

    With Range("A:A")
        Set LastCell = .Cells(.Cells.Count)
    End With
    Set FoundCell = Range("A:A").Find(What:=":", After:=LastCell)
    
    If Not FoundCell Is Nothing Then
        FirstAddr = FoundCell.Address
    End If

    ReDim aData(1 To Rows.Count, 1 To 2)
    Do Until FoundCell Is Nothing
        n = n + 1
        aData(n, 1) = Replace(FoundCell.Value, ":", "")
        aData(n, 2) = FoundCell.Offset(4).Value
        Set FoundCell = Range("A:A").FindNext(After:=FoundCell)
        If FoundCell.Address = FirstAddr Then
            Exit Do
        End If
    Loop
    
    Worksheets.Add
    Range("a1").Resize(n, UBound(aData, 2)) = aData
End Sub

**bnasty** · 10-27-2012, 11:45 AM

Awesome!!! Thank you, works like a charm.

**Cutter** · 10-27-2012, 04:32 PM

If you are satisfied with the solution(s) provided, please remember to mark your thread as Solved.

New quick method:
Select Thread Tools (above first post on page) -> Mark thread as Solved. To undo, select Thread Tools-> Mark thread as Unsolved.

Or you can use this way:
Go to the first post
Click edit
Click Go Advanced
Just below the word "Title" you will see a dropdown with the words "No prefix".
Change to "Solved"
Click Save

Also, as a new member of the forum, you may not be aware that you can thank those who have helped you by clicking the small star icon located in the lower left corner of the post in which the help was given. By doing so you can add to the reputation(s) of those who helped.