Really stuck on using VB to sort Raw data in standard layout

[Dave01]

Hi,

Im really stuck and getting nowhere fast, mainly because I dont know VB. Im pretty good when it comes to excel formulas, but it looks like what I am tring to do will only work through VB, and it isnt a really complicated issue either, just I have no idea what I am doing when it comes to VB.

So this is what Im tring to do, We download a payment run from SAP into excel, but even though it is in columns its always messy to work with, a macro, which I have recorded is working and does sort out the data into a new tab. The problem is this only works for 1 entity, (Belgium) but we have many entites, France, Spain etc, which always seems to come out in a different yet similar layout, it maybe a few columns out, or include extra columns I dont want, this means that my macro will not work, unless the layout is exactly the same as the the 1st entity which the Macro was recorded, (Belgium)

So what I will end up with is 1 spreadsheet, where I drop the data into a tab called Downloaded Raw Proposal, do a new Macro / VB code where it will look for the columns it needs, ie search by headers, then copy the entire column, inc all the data and paste it into the relevent column as shown below.

[TABLE="width: 0"]
<tbody>[TR]
[TD]Cell Ref needed
[/TD]
[TD]Description
[/TD]
[/TR]
[TR]
[TD]D5
[/TD]
[TD]Payment
[/TD]
[/TR]
[TR]
[TD]F6
[/TD]
[TD]CoCd
[/TD]
[/TR]
[TR]
[TD]I6
[/TD]
[TD]DocumentNo
[/TD]
[/TR]
[TR]
[TD]L6
[/TD]
[TD]Type
[/TD]
[/TR]
[TR]
[TD]M6
[/TD]
[TD]Doc Date
[/TD]
[/TR]
[TR]
[TD]O6
[/TD]
[TD]Blind Date
[/TD]
[/TR]
[TR]
[TD]R6
[/TD]
[TD]PayT
[/TD]
[/TR]
[TR]
[TD]T6
[/TD]
[TD]FC gross amount
[/TD]
[/TR]
[TR]
[TD]U6
[/TD]
[TD] Tot.ded.in FC
[/TD]
[/TR]
[TR]
[TD]V6
[/TD]
[TD]Net amnt. in FC
[/TD]
[/TR]
[TR]
[TD]W6
[/TD]
[TD]Crcy
[/TD]
[/TR]
[TR]
[TD]Y6
[/TD]
[TD]Err
[/TD]
[/TR]
</tbody>[/TABLE]


I have attached two pictures of the correct layout and the wrong layout, the columns and data must always be in the same layout as the correct picture, however these layouts except the correct one always change per entity, so they might also change on the next download, or if someone else runs them.

We and our IT \ SAP Consultants have been unable to change the layouts in SAP for the pay proposals, which is why we need this template file.

In the attached spreadsheet the Tab named New Raw data dump, contains a report which is the wrong layout,

The yellow tab - Download Raw Proposal - is where the Macro (red tab) - Run Report picks up the data and the blue tab is where is put in a more user friendly way.


I hope I have explained it well.

Help would be highly gratefully received.

Hi,

 

[mumps]

Try:

Sub PrepareSAPPayReport()
    Application.ScreenUpdating = False
    Dim LastRow As Long, LastRow2 As Long, i As Long, srcWS As Worksheet, desWS As Worksheet, headerArray As Variant, fnd As Range, x As Long: x = 2
    Set srcWS = Sheets("1) Download RAW Proposal")
    Set desWS = Sheets("3) Pay Proposal Report")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Intersect(srcWS.Rows("8:" & LastRow), srcWS.Columns("C:C")).Copy desWS.Cells(4, 1)
    headerArray = Array("BusA", "CoCd", "DocumentNo", "Doc. Date", "Net amnt. in FC", "Crcy", "Err")
    For i = LBound(headerArray) To UBound(headerArray)
        Set fnd = srcWS.Rows(6).Find(headerArray(i), LookIn:=xlValues, lookat:=xlWhole)
        Intersect(srcWS.Rows("8:" & LastRow), srcWS.Columns(fnd.Column)).Copy desWS.Cells(4, x)
        x = x + 1
    Next i
    LastRow2 = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    With desWS.Range("I4")
        .Formula = "=IFERROR(IF(ISBLANK(H4),"""",VLOOKUP(H4,Lookups!A:B,2,FALSE)),"""")"
        .AutoFill .Resize(LastRow2 - 4, 1)
    End With
    Application.ScreenUpdating = True
End Sub

 

[Dave01]

https://www.dropbox.com/s/9kihqjgdc4s7kup/GB09.xls?dl=0 - GB09
https://www.dropbox.com/s/k03awidshkaqwak/GB08.xls?dl=0 - GB08

It works - all four test files works perfect, no errors and all in the same column.


I tried to do another one from another users machine and that worked to, but produced an error on line

Intersect(srcWS.Rows("8:" & LastRow), srcWS.Columns(fnd.Column)).Copy desWS.Cells(4, x)

when you click end and check the report - its all in there, so I dont know why its producing the

I have attached the GB09 + GB08 file to show you what I mean.

cant believe its so close to cracking it.

it would be good if when the code is finished it would clear the download tab + new data, and finish on the report.

thank you so much for your help.

 

[Dave01]

https://www.dropbox.com/s/whfwwd6sci03nfm/V3.Test.Payment Proposal Organised Template.xlsm?dl=0

template file V3 shared

 

[mumps]

You may recall that one of the conditions that must always be true is that the names of the columns that are to be copied must always be the same. In the 2 files you posted, the column name in cell S6 is "Document Date". All the previous files the column name was "Doc. Date". The macro is looking for "Doc. Date" so when it doesn't find it, an error is generated. If this happens with any other column, you'll have the same problem. Do you want to clear the "1) Download RAW Proposal" sheet?

 

[Dave01]

You may recall that one of the conditions that must always be true is that the names of the columns that are to be copied must always be the same. In the 2 files you posted, the column name in cell S6 is "Document Date". All the previous files the column name was "Doc. Date". The macro is looking for "Doc. Date" so when it doesn't find it, an error is generated. If this happens with any other column, you'll have the same problem. Do you want to clear the "1) Download RAW Proposal" sheet?

yes please - I didnt see that about column names, I was looking at the length. - Ill just write within the instructions - change document date to doc date.

thanks.

 

[mumps]

Try:

Sub PrepareSAPPayReport()
    Application.ScreenUpdating = False
    Dim LastRow As Long, LastRow2 As Long, i As Long, srcWS As Worksheet, desWS As Worksheet, headerArray As Variant, fnd As Range, x As Long: x = 2
    Set srcWS = Sheets("1) Download RAW Proposal")
    Set desWS = Sheets("3) Pay Proposal Report")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Intersect(srcWS.Rows("8:" & LastRow), srcWS.Columns("C:C")).Copy desWS.Cells(4, 1)
    headerArray = Array([COLOR="#FF0000"]"BusA", "CoCd", "DocumentNo", "Doc. Date", "Net amnt. in FC", "Crcy", "Err"[/COLOR])
    For i = LBound(headerArray) To UBound(headerArray)
        Set fnd = srcWS.Rows(6).Find(headerArray(i), LookIn:=xlValues, lookat:=xlWhole)
        Intersect(srcWS.Rows("8:" & LastRow), srcWS.Columns(fnd.Column)).Copy desWS.Cells(4, x)
        x = x + 1
    Next i
    LastRow2 = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    With desWS.Range("I4")
        .Formula = "=IFERROR(IF(ISBLANK(H4),"""",VLOOKUP(H4,Lookups!A:B,2,FALSE)),"""")"
        .AutoFill .Resize(LastRow2 - 4, 1)
    End With
    srcWS.UsedRange.ClearContents
    Application.ScreenUpdating = True
End Sub

I just noticed that the GB08 file had another column with a different header. In cell AD6 it has "Net amount in FC" while the macro is looking for "Net amnt. in FC". There has to be consistency in the column headers or the macro won't work properly. I highlighted the headers in red that the macro will search for.

 

[Dave01]

Hi Thanks for your hard work on the code, It works perfect 4 of 6 spreadsheets, I havnt got it to work with the GB files. I think I will just have to have a separate template file just for GB. is there any way you could modify this code, to work with the 2 GB Files ?
GB08 / GB09, please?

https://www.dropbox.com/s/bpf3lhm8yg6o2wr/V3GB .Test.Payment Proposal Organised Template.xlsm?dl=0

https://www.dropbox.com/s/wzs8e3a771z39jd/GB08.xls?dl=0 - GB08

https://www.dropbox.com/s/pzcnliouyl376tk/GB09.xls?dl=0 - GB09

GB08 seems to work up to Net amount, but puts the date instead and then Currency + Error Code + Output text is blank. The date although in the wrong column, doesnt seem to put them on odd lines.
GB09 seems to have the same issue.

If you could help me fix the two issues on a separate template file V3GB template etc etc, then I can run two template files and we can start using it.

thanks for your help

 

[mumps]

The problem again was with a column header not matching (in red). The original macro looked for "Doc. date". That is the only change. Before you run the macro, you can check the header names in the macro against those is the file. If they don't match, you can change the header names in the macro to match those in the file or vice versa. I also changed the part in blue. The original macro had "xlWhole" instead of "xlPart". You should make this change in the original macro as well. The reason for this change is that the header "Net amount in FC" in the 2 files has 2 leading spaces in it:
" Net amount in FC". By changing "xlWhole" to "xlPart", the macro will ignore the 2 leading spaces. Otherwise those spaces will generate an error.
This version should work with the last 2 files you uploaded:

Sub PrepareSAPPayReport()
    Application.ScreenUpdating = False
    Dim LastRow As Long, LastRow2 As Long, i As Long, srcWS As Worksheet, desWS As Worksheet, headerArray As Variant, fnd As Range, x As Long: x = 2
    Set srcWS = Sheets("1) Download RAW Proposal")
    Set desWS = Sheets("3) Pay Proposal Report")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Intersect(srcWS.Rows("8:" & LastRow), srcWS.Columns("C:C")).Copy desWS.Cells(4, 1)
    headerArray = Array("BusA", "CoCd", "DocumentNo", "[COLOR="#FF0000"]Document Date[/COLOR]", "Net amount in FC", "Crcy", "Err")
    For i = LBound(headerArray) To UBound(headerArray)
        Set fnd = srcWS.Rows(6).Find(headerArray(i), LookIn:=xlValues, lookat:=[COLOR="#0000FF"]xlPart[/COLOR])
        Intersect(srcWS.Rows("8:" & LastRow), srcWS.Columns(fnd.Column)).Copy desWS.Cells(4, x)
        x = x + 1
    Next i
    LastRow2 = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    With desWS.Range("I4")
        .Formula = "=IFERROR(IF(ISBLANK(H4),"""",VLOOKUP(H4,Lookups!A:B,2,FALSE)),"""")"
        .AutoFill .Resize(LastRow2 - 4, 1)
    End With
    srcWS.UsedRange.ClearContents
    Application.ScreenUpdating = True
End Sub

 

[Dave01]

It works great on the 2 GB Files. I will have to run 2 versions the previous code and this one, due to those headers, as thats how it comes off SAP, which is big deal. Thanks for all your help, withought you, this would have been scrapped.

 

[mumps]

My pleasure.