ExcelBanter - incredibly dificult formatting problem

Hi

It was quite a request. I think this is what you need.

Sub Half_Greek()
Dim LastRow As Integer
Dim tCell As Range
Dim wb As Workbook
Dim wb1 As Workbook

Set wb1 = ThisWorkbook
LastRow = Cells(Rows.Count, "A").End(xlUp).Row

Range("A1", Cells(LastRow, "J")).Sort Key1:=Range("B1"),
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Set tCell = Range("B1")
Do Until IsNumeric(Left(tCell.Value, 1)) = False
Set tCell = tCell.Offset(1, 0)
Loop
Set wb = Workbooks("withoutpos.xls")
wb1.Activate
Range("A1", Cells(tCell.Row - 1, "H")).Copy
wb.Activate
ActiveSheet.Paste Destination:=Sheets("Sheet1").Range("A1")
Application.CutCopyMode = False

wb1.Activate
Rows("1:" & tCell.Row - 1).Delete
wb.Activate

Range("A1", Cells(LastRow, "H")).Sort Key1:=Range("D1"),
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Set tCell = Range("D1")
Do Until IsEmpty(tCell.Value) = True
Set tCell = tCell.Offset(1, 0)
Loop

Range(Cells(tCell.Row, "D"), Cells(LastRow, "D")).Cut Destination:=tCell

Range("A1", Cells(LastRow, "H")).Sort Key1:=Range("F1"),
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Set tCell = Range("F1")
Do Until IsEmpty(tCell.Value) = True
If tCell.Value Like "Email:*" Then
tCell.Cut Destination:=tCell.Offset(0, 2)
End If
Set tCell = tCell.Offset(1, 0)
Loop

Range("A1", Cells(LastRow, "H")).Sort Key1:=Range("G1"),
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Set tCell = Range("G1")
Do Until IsEmpty(tCell.Value) = True
If tCell.Value Like "Email:*" Then
tCell.Cut Destination:=tCell.Offset(0, 1)
End If
Set tCell = tCell.Offset(1, 0)
Loop

Range("A1", Cells(LastRow, "H")).Sort Key1:=Range("G1"),
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Range("G1", Range("G1").End(xlDown)).Cut Destination:=Range("E1")

Columns("G").Delete

Set tCell = Range("A1")
Do Until IsEmpty(tCell) = True
fComma = InStr(1, tCell.Value, ",", 1)
nComma = InStr(fComma + 1, tCell.Text, ",", vbTextCompare)
CopyText = LTrim(Mid(tCell.Text, nComma + 1))

If Trim(CopyText) = "MD" Or Trim(CopyText) = "DR" Then
tCell.Offset(0, 7).Value = CopyText
Else
tCell.Offset(0, 8).Value = CopyText
End If
Set tCell = tCell.Offset(1, 0)
Loop
End Sub

Best regards,
Per

"half-geek" skrev i meddelelsen
...
I just started learning VBA yesterday but this is urgent and i have no
clue as to how to do it.

For this excel sheet: http://www.mediafire.com/?tyxcnkdb4wd

What i need to do is that
1) Sort by column B so that the cells with numbers come out on top, it
is a sort ascending function
2) i need to find a way for visualbasic to know that i only want to
select up to the last cell in column B that starts with numbers. I
need to then take all of the cells from A1 until HX (where X is the
row number of the last numerical B cell) and copy it and paste it to
another workbook named withoutpos.xls
3) i need to delete those rows i just copied in the original workbook
4) in the workbook i copied to (withoutpos.xls) i need to sort row D
ascending. i need visualbasic to look for the first blank cell in
column D and take the cells in C starting from that row and
continuing. (for example if column D has 13 filled cells and the 14th
is empty, visualbasic will tell excel to move the contents of column C
starting from C14, to column D starting with D14)
5) Now i need to sort column F ascending. i need Excel to move all
cells starting with "Email:" to column H
6) Now i need to sort column G ascending. i need Excel to move all
cells starting with "Email:" to column H
7) Now i need to resort column G and move all of it's cells that are
filled to column E
8) i need to delete G now (what was formerly column H becomes column G
now)
9) FINALLY i need to have excel take all of the text following the
second comma in column A cells and copy to column I (not H). If there
is either "MD" or "DO" in the copied text i need them to go into
column H