Help format report

[ksuwyldkat]

I have a report that shows on the screen that I copy and paste into Excel for formating. The macro that I built now does not work as the layout is different. I need to get the information in the first sheet to be laid out like the second sheet. The issue is the account number is not on the same row and is in a text field that needs to be parsed.

[ksuwyldkat]

Another issue is that if there are multiple items for the same account, the account is only listed once. I need to have the account field populated for each item. So not only do I need to add a column for the account, then parse out the account number from the text field and then if there are multiple items it needs to add the account number from the previous section.

[ksuwyldkat]

Any ideas on how to parse the account # and move it to another field or how to auto fill the existing account # for those that don't have the account listed above?

[ksuwyldkat]

I have been working on this but so far little success. I have been able to delete the header (date etc.) and unmerge the cells and add the column. I added a msgBox just to make sure they want to do this and I think I have the code to find the word account but it is not moving it to the next row down.

Sub rept1()
' rept1 Macro
'Declarations
Dim confirm As Integer
Dim TheEnd As Integer
'Make sure it is okay to format
confirm = MsgBox("Do you want to format the Report?", vbExclamation + vbOKCancel, "ARP Macro")
If confirm = vbCancel Then
GoTo TheEnd
ElseIf confirm = vbOK Then
'Format Worksheet
'select all and get rid of merged cells
    Cells.Select
    With Selection
        .MergeCells = False
    End With
'delete the first two rows
'then insert new column A
    Rows("1:2").Select
    Selection.Delete Shift:=xlUp
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
' Cut out the text in the account
 Dim myWords As String
 myWords = "Accounts:"
     Cells.Find What:=myWords, lookat:=xlWhole
      If ActiveCell.Value = myWords Then ActiveCell.Value = Right(ActiveCell.Value, 21)
'Find Account text and move cell down a level
    lastrow = ActiveSheet.UsedRange.Rows.Count
    For i = lastrow To 1 Step -1
            If ActiveCell.Value = myWords Then
        Cells("B" & i - 1 & 2).Copy Destination:=Cells("A" & i)
    End If
    Next i
End If
TheEnd:
End Sub

[TonyJollans]

Hi ksuwyldkat,

I'm not entirely sure what you want here but if your report is exactly like the one you posted this should get you started ..

Sub ReportExtract() 
Dim lReportRow As Long
Dim lSheetRow As Long
Dim lAccount As Long
lSheetRow = 2
lReportRow = 3
Do Until Sheets("New Report").Cells(lReportRow, 1) = ""
If Split(Sheets("New Report").Cells(lReportRow, 1))(0) = "Account:" Then
' New Account - Save Number and skip next row (headings)
lAccount = CLng(Split(Sheets("New Report").Cells(lReportRow, 1))(1))
        lReportRow = lReportRow + 2
Else
' Detail row
Sheets("Sheet3").Cells(lSheetRow, 1) = lAccount
        Sheets("Sheet3").Cells(lSheetRow, 2) = Sheets("New Report").Cells(lReportRow, 1)
        Sheets("Sheet3").Cells(lSheetRow, 3) = Sheets("New Report").Cells(lReportRow, 2)
        Sheets("Sheet3").Cells(lSheetRow, 4) = Sheets("New Report").Cells(lReportRow, 4)
        Sheets("Sheet3").Cells(lSheetRow, 5) = Sheets("New Report").Cells(lReportRow, 5)
        Sheets("Sheet3").Cells(lSheetRow, 6) = Sheets("New Report").Cells(lReportRow, 6)
        Sheets("Sheet3").Cells(lSheetRow, 7) = Sheets("New Report").Cells(lReportRow, 7)
        Sheets("Sheet3").Cells(lSheetRow, 8) = Sheets("New Report").Cells(lReportRow, 8)
lSheetRow = lSheetRow + 1
        lReportRow = lReportRow + 1
End If
Loop
End Sub

[ksuwyldkat]

TonyJollans,

Thank you soooooo much. I just tried it and I think this will work. I am going to study this to find out exactly how this works. You do not understand how much work this will save.

Thank you again and I am in awe of how simply you were able to accomplish this.

Admins - can you mark this as solved?

[TonyJollans]

My pleasure!

[yogeshwarv]

ya it's perfectly working..

We can extract all records of all accoun nos within no time. Thanks

By this way is it possible if we can extract the record for a specific account no exist in database or prompt with "Account No. does not exist"

Please help...!!

Regards

Yogeshwar