Convert bad SAP report into nice table

[Krisz06]

Hello everyone,
I need some help. I'm trying to create a macro which converts a (really bad) SAP report to a good table with only the necessary info.
The table is about vendors. Till the last step everything works correctly.
But there is a little problem, the report contains the existing data from the system and in some case there are an extra line ("street 2" field). That ruins the macro logic as the last step says "ActiveCell.Offset(1, -10).Range("A1:A71").Select"
In some case it should be 72 instead of 71.

Here is the code:

Sub XYZ ()


Range("C9").Select


Do
If Selection.Value = "" Then Exit Do


ActiveCell.Offset(6, 0).Range("A1").Select
Selection.Copy
ActiveCell.Offset(-6, 1).Range("A1").Select
ActiveSheet.Paste


ActiveCell.Offset(6, 7).Range("A1").Select
Selection.Cut
ActiveCell.Offset(-6, -6).Range("A1").Select
ActiveSheet.Paste


ActiveCell.Offset(13, -2).Range("A1").Select
Selection.Cut
ActiveCell.Offset(-13, 3).Range("A1").Select
ActiveSheet.Paste


ActiveCell.Offset(13, 5).Range("A1").Select
Selection.Cut
ActiveCell.Offset(-13, -4).Range("A1").Select
ActiveSheet.Paste


ActiveCell.Offset(17, -4).Range("A1").Select
Selection.Cut
ActiveCell.Offset(-17, 5).Range("A1").Select
ActiveSheet.Paste


ActiveCell.Offset(26, 3).Range("A1").Select
Selection.Cut
ActiveCell.Offset(-26, -2).Range("A1").Select
ActiveSheet.Paste


ActiveCell.Offset(42, -6).Range("A1").Select
Selection.Cut
ActiveCell.Offset(-42, 7).Range("A1").Select
ActiveSheet.Paste


ActiveCell.Offset(11, 1).Range("A1").Select
Selection.Cut
ActiveCell.Offset(-11, 0).Range("A1").Select
ActiveSheet.Paste


ActiveCell.Offset(64, -8).Range("A1").Select
Selection.Cut
ActiveCell.Offset(-64, 9).Range("A1").Select
ActiveSheet.Paste


ActiveCell.Offset(65, -9).Range("A1").Select
Selection.Cut
ActiveCell.Offset(-65, 10).Range("A1").Select
ActiveSheet.Paste


ActiveCell.Offset(1, -10).Range("A1:A71").Select
Selection.EntireRow.Delete
ActiveCell.Select


Loop


End Sub

I have been thinking on 2 possible solution:
Somehow using "Selection.End(xlDown).Select".. with this a little problem that there is an empty cell in that columnThe other option is to remove every line which contain "Street2" in the column B.. that would make all separate vendor has only 71 line.




Can someone please help?
Thank you!

 

[BerndKuerzinger]

Can you post a screenshot (or mockup if confidential) of the report you are trying to reformat? A bit hard to follow just based on your description.

Regards, Bernd

 

[Krisz06]

Here is a screenshot of the table.
It is a report and has a lot of unnecessary thing on it, the total report is almost 50.000 lines. The loop working fine, only this one additional line mess it up.

https://imgur.com/a/5N83l

 

[BerndKuerzinger]

Krisz06,

If it is just about checking for "Street2" you could use a COUNTIF (see below) for the last part of your code. Obviously this is a bit of a hack which only works for this specific case, but it probably is more straightforward that changing your overall macro.

'(prior code) ...

If Application.WorksheetFunction.CountIf(Range("A1:A71"),"Street2") = 1 then
  ActiveCell.Offset(1, -10).Range("A1:A72").Select
  Selection.EntireRow.Delete
Else
  ActiveCell.Offset(1, -10).Range("A1:A71").Select
  Selection.EntireRow.Delete
End if

ActiveCell.Select

Loop
End Sub

Hope this helps,
Bernd

 

[Krisz06]

Dear BerndKuerzinger,

Thank you for this advise, it sounds perfect. I was also thinking on some similar hack.
Unfortunately there is something wrong with it still. I think it is because the CountIf has "Application.WorksheetFunction.CountIf(Range("A1:A71"),"Street2") = 1 "
The Range A1:A71 should count 71 cell below the active cell. I guess currently it is just checking A1:A71. Mine should be under B9 cell, but with the loop going on the row is growing always.
I am not sure how to fix this, tried with the Offset function but couldn't figure out.




Could you please help?
Thanks!

 

[BerndKuerzinger]

A bit hard to tell with all the offsets in your macro

Maybe try this one:

'(prior code) ...

If Application.WorksheetFunction.CountIf([COLOR=#ff0000]ActiveCell.Offset(1,0).Range("B1:B71")[/COLOR],"Street2") = 1 then
  ActiveCell.Offset(1, -10).Range("A1:A72").Select
  Selection.EntireRow.Delete
Else
  ActiveCell.Offset(1, -10).Range("A1:A71").Select
  Selection.EntireRow.Delete
End if

ActiveCell.Select

Loop
End Sub

This should apply the CountIf Formula on the 71 rows in column B below your active cell.

Let me know how it goes.

Regards,
Bernd

 

[BerndKuerzinger]

Hi Krisz,
Sorry I was a bit fast in submitting my response and made an error in the code. The red code section should actually look like this:

[COLOR=#ff0000]Cells(ActiveCell.Row,2).Offset(1,0).Range("A1:A71")
[/COLOR]

Regards,
Bernd

 

[Krisz06]

Dear Bernd,

Thank you very much! This works perfectly.
But unfortunately I have found out in the meantime that this SAP report is a mess and later in the report some vendor details became completely different, so not only 71 or 72 is the difference but there are a lot of other scenarios.. (some down to 60, some up to 80..)

But at least I have learned how to use the function inside activecell with offset. Later I will re-read your formula after a coffee :D :D


One more thing came to my mind which could maybe fix the issue. What if we try to find the last row which has the name "Memo" in the column B, and delete till that row+1 (that is basically the 71 or 72 in our previous scenarios)
Here is a screenshot:

https://imgur.com/a/WroG2

Do you think this would be possible?
Or to "find Memo and delete till the next line", or something with "Selection.End(xlDown).Select"?

Thank you again!

 

[Fluff]

Hi
Does this do what you want?

Sub XYZ()
'Krisz06
    
    Dim Srng As Range
    Dim Erng As Range
    
    Range("C9").Select
    
    Do Until ActiveCell.Value = ""
    
        With ActiveCell
            .Offset(6).Copy .Offset(, 1)
            .Offset(6, 8).Cut .Offset(, 2)
            .Offset(13).Cut .Offset(, 3)
            .Offset(13, 8).Cut .Offset(, 4)
            .Offset(17).Cut .Offset(, 5)
            .Offset(26, 8).Cut .Offset(, 6)
            .Offset(42).Cut .Offset(, 7)
            .Offset(11, 8).Cut .Offset(, 8)
            .Offset(64).Cut .Offset(, 9)
            .Offset(65).Cut .Offset(, 10)
            Set Srng = ActiveCell.Offset(1)
            On Error Resume Next
            Set Erng = Columns("C:C").Find(What:="memo", After:=ActiveCell, LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False).Offset(1)
            On Error GoTo 0
            If Erng Is Nothing Then
                Set Erng = Range("C" & Rows.Count).End(xlUp)
            End If
            Range(Srng, Erng).EntireRow.Delete
            .Offset(1).Select
            Set Srng = Nothing
            Set Erng = Nothing
        End With
    Loop

End Sub

Make sure you try this on a copy of your data, as it is untested.

 

[Krisz06]

Hi Fluff,

Thank you for your answer.
Unfortunately it is also not working.
It deletes every line under the selection, somehow the selection doesn't stop with the line after the Memo cell.

I have updated the code to the columns how is my table, but I think the problem can be still there with the columns.

Sub XYZ()
'Krisz06
    
    Dim Srng As Range
    Dim Erng As Range
    
    Range("C9").Select
    
    Do Until ActiveCell.Value = ""
    
        With ActiveCell
            .Offset(6).Copy .Offset(, 1)
            .Offset(6, 8).Cut .Offset(, 2)
            .Offset(13).Cut .Offset(, 3)
            .Offset(13, 8).Cut .Offset(, 4)
            .Offset(17).Cut .Offset(, 5)
            .Offset(26, 8).Cut .Offset(, 6)
            .Offset(42).Cut .Offset(, 7)
            .Offset(11, 8).Cut .Offset(, 8)
            .Offset(64).Cut .Offset(, 9)
            .Offset(65).Cut .Offset(, 10)
            Set Srng = ActiveCell.Offset(1)
            On Error Resume Next
            Set Erng = Columns("B:B").Find(What:="Memo", After:=ActiveCell, LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False).Offset(1)
            On Error GoTo 0
            If Erng Is Nothing Then
                Set Erng = Range("B" & Rows.Count).End(xlUp)
            End If
            Range(Srng, Erng).EntireRow.Delete
            .Offset(1).Select
            Set Srng = Nothing
            Set Erng = Nothing
        End With
    Loop


End Sub

So, maybe the problem is with the columns.. The situation is that the activecell is column C, but the Memo line is in column B.
And also in column B, there is an empty cell between the rows..