VBA - Before After macro no 3

Hi

I have the excel file with again 2 sheets:
Before
Recap

I need to transfer single combination from Before sheet on column B, E, F.into sheet Recap in column BE, BF and BG.

Once transferred into sheet Recap, i need to sort by Vendor column BE.

How can I do this?

Sheet Before look's like:
Sheet-Before.jpg
Sheet Recap will look like this based on above sheet Before:
Sheet-Recap.jpg
This is what i have so far:
Dim lrow As Long
    Dim ws As Worksheet, ws1 As Worksheet
 
    Set ws = Sheets("Before")
    Set ws1 = Sheets("Recap")
    lrow = ws.Cells(Cells.Rows.Count, "B").End(xlUp).Row
    lr = ws1.Cells(Cells.Rows.Count, "d").End(xlUp).Row

    If lr > 10 Then ws1.Range("BE2:BG" & lr).ClearContents

     ws.Range("B2:F" & lrow).Copy ws1.Range("BE3")
    lr = ws1.Cells(Cells.Rows.Count, "d").End(xlUp).Row

    ws1.Range("BE3:BF" & lr).RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo
    
    Set oneRange = Range("BE3:BG75000")
    Set aCell = Range("BE3")
    oneRange.Sort Key1:=aCell, Order1:=xlAscending

Open in new window

FIND-MATCH-no-2.xlsm
LVL 11
Wilder1626Asked:
Who is Participating?
 
Wilder1626Author Commented:
Found out 1 Small issue.

Now fix:
    Application.ScreenUpdating = False

    'Clear final result range
    Sheets("Recap").Range("BE3:BG75000").Clear

    Dim lrow As Long
    lrow = Sheets("Before").Cells(Cells.Rows.Count, "B").End(xlUp).Row + 1
    
    'Put column in Text format & Align xlCenter column on final result
    Columns("BE:BG").NumberFormat = "@"
    Columns("BE:BG").HorizontalAlignment = xlCenter
    
    'Transfer data from One sheet to the other
    Sheets("Recap").Range("BE2:BE" & lrow).Value = Sheets("Before").Range("B1:B" & lrow).Value
    Sheets("Recap").Range("BF2:BF" & lrow).Value = Sheets("Before").Range("E1:E" & lrow).Value
    Sheets("Recap").Range("BG2:BG" & lrow).Value = Sheets("Before").Range("F1:F" & lrow).Value
    
    'Remove duplicate from final list
    Sheets("Recap").Range("BE2:BG" & lrow).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes

Open in new window

0
 
Martin LissOlder than dirtCommented:
Try recording a macro while you do it manually.
0
 
Wilder1626Author Commented:
If i do a recording macro, and use sheet2 to do all conversion, it would look something like below. But i don't like to use another sheet for that.

Sheets("Sheet2").Range("A1:G75000").ClearContents

Sheets("Before").Columns("B:F").Copy

Sheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
Columns("B:C").Delete Shift:=xlToLeft
Range("D2").Select
ActiveCell.FormulaR1C1 = "=RC[-3]&RC[-2]&RC[-1]"
Range("D2").Select

Selection.AutoFill Destination:=Range("D2:D75000"), Type:=xlFillDefault
ActiveSheet.Range("$A$1:$D$75000").RemoveDuplicates Columns:=Array(1, 2, 3, 4), _
Header:=xlYes

Range("A1:C7500").Select
Selection.Copy

Sheets("Recap").Select
Range("BE2").Select
ActiveSheet.Paste
Range("BE2").Select

Open in new window

0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
Martin LissOlder than dirtCommented:
I probably don't understand your need but why not use the sheet you want instead of Sheet2? If there is no current sheet you can se then you can create a sheet (or use Sheet2) and hide it.
0
 
Wilder1626Author Commented:
I'm looking at the snapshot i provided and i see why it is a little confusing.

If you see in sheet Before, you may see multiple duplication based on columns B,E and F.

I want to sent in Sheet Recap One record of each only. No Duplication.

Sheet Before:
Sheet Before
Sheet Recap with one record of each:
Sheet Recap
0
 
Wilder1626Author Commented:
I have just cleaned the macro with the sheet2 but still trying not to use an extra sheet.

       Application.ScreenUpdating = False

    Sheets("Sheet2").Range("A1:G75000").ClearContents
    
    Sheets("Before").Select
    Range("B:B,E:E,F:F").Select
    Range("F1").Activate
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("$A$1:$C$75000").RemoveDuplicates Columns:=Array(1, 2, 3), _
                                                        Header:=xlYes
    Range("A1:C20").Select
    Selection.Copy
    Sheets("Recap").Select
    Range("BE2").Select
    ActiveSheet.Paste
    Range("BE2").Select

    Application.ScreenUpdating = True

Open in new window

0
 
Wilder1626Author Commented:
Even better and also by only using Recap sheet

Application.ScreenUpdating = False

    Sheets("Sheet2").Range("BE3:BG75000").ClearContents
    
    Sheets("Before").Select
    Range("B1:B65000,E1:E65000,F1:F65000").Select
    Range("F1").Activate
    Selection.Copy
    Sheets("Recap").Select
    Range("BE2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("$BE$2:$BG$65000").RemoveDuplicates Columns:=Array(1, 2, 3), _
        Header:=xlYes
    Range("BE2").Select
    
 Application.ScreenUpdating = True

Open in new window

0
 
Wilder1626Author Commented:
I think i got it now. I think it's a little late for me!!!!!! :)

    Application.ScreenUpdating = False

    Sheets("Recap").Range("BE3:BG75000").ClearContents

   Dim lrow As Long
    lrow = Sheets("Before").Cells(Cells.Rows.Count, "B").End(xlUp).Row
    Sheets("Recap").Range("BE3:BE" & lrow).Value = Sheets("Before").Range("B2:B" & lrow).Value
    Sheets("Recap").Range("BF3:BF" & lrow).Value = Sheets("Before").Range("E2:E" & lrow).Value
    Sheets("Recap").Range("BG3:BG" & lrow).Value = Sheets("Before").Range("F2:F" & lrow).Value

    Application.CutCopyMode = False
    ActiveSheet.Range("$BE$2:$BG$65000").RemoveDuplicates Columns:=Array(1, 2, 3), _
                                                          Header:=xlYes

    Application.ScreenUpdating = True

Open in new window

0
 
Wilder1626Author Commented:
Again even better. I don't know if it can get better.

    Application.ScreenUpdating = False

    Sheets("Recap").Range("BE3:BG75000").ClearContents

   Dim lrow As Long
    lrow = Sheets("Before").Cells(Cells.Rows.Count, "B").End(xlUp).Row
    Sheets("Recap").Range("BE3:BE" & lrow).Value = Sheets("Before").Range("B2:B" & lrow).Value
    Sheets("Recap").Range("BF3:BF" & lrow).Value = Sheets("Before").Range("E2:E" & lrow).Value
    Sheets("Recap").Range("BG3:BG" & lrow).Value = Sheets("Before").Range("F2:F" & lrow).Value

    Sheets("Recap").Range("BE2:BG" & lrow).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes

    Application.ScreenUpdating = True

Open in new window

0
 
Wilder1626Author Commented:
This is even better for me so far:

    Application.ScreenUpdating = False

    Sheets("Recap").Range("BE3:BG75000").Clear

    Dim lrow As Long
    lrow = Sheets("Before").Cells(Cells.Rows.Count, "B").End(xlUp).Row
    Sheets("Recap").Range("BE3:BE" & lrow).Value = Sheets("Before").Range("B2:B" & lrow).Value

    Columns("BE:BG").NumberFormat = "@"

    Sheets("Recap").Range("BF3:BF" & lrow).Value = Sheets("Before").Range("E2:E" & lrow).Value
    Sheets("Recap").Range("BG3:BG" & lrow).Value = Sheets("Before").Range("F2:F" & lrow).Value
    Sheets("Recap").Range("BE2:BG" & lrow).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes

    Columns("BE:BG").HorizontalAlignment = xlCenter

Open in new window

0
 
Martin LissOlder than dirtCommented:
Do you still have a problem here?
0
 
Wilder1626Author Commented:
I'm all good with the last code I've shared.

Thanks for your support :)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.