Automating a Task with VBA - Moving Data between sheets

[Faseeh]

Hi,

Thank you so much for going through the post!

I am struggling with the automation of the following task. I have googled a lot but the existing macros either fulfil part of the total requirement or are not working for me (somehow).

I have two sheets: 1. Source 2. Ledger. I am trying to pass rows from one to another. here are the details.


Desired workflow:

1) Compare WO_Plan_Ledger (let’s call this LEDGER) against the SOURCE by Work Order Number and Quantity and Date Requested.
2) If Work Order Number does not exist within the SOURCE, then delete all records with the same Work Order Number from the Ledger.
4) If the Work Order Number exists within the SOURCE and the LEDGER, compare the details of the Work Order (SKU, Request Date, total sum of the Qty).
a. If Details are the same, do nothing and move on to the next Work Order Number
b. If Details are different, append the record to the LEDGER and change the LEDGER record’s row font colour to red to indicate that there’s a variance.
5) If the Work Order Number exists within the SOURCE but not the LEDGER, then append the record (Work Order Number, SKU, Request Date and Qty) into the LEDGER and change the LEDGER record’s row font colour to orange to indicate that it’s new.

I have worked out till the second point, (see macro COMPARE2) that deletes WO not found in Source.

Kindly help me with the remaining tasks.

Attached: Sample Sheet.

 

[Marc L]

Hi,​

​

as often in VBA different ways are possible, how many rows in the real workbook for each worksheet ?​

​

 

[Faseeh]

For now around 700 for each of the sheet but as it holds work orders, the number of rows will increase.

 

[Marc L]

According to your attachment a VBA demonstration :​

Sub Demo1()
      Const C = "A1:A#&""¤""&B1:B#&""¤""&C1:C#&""¤""&D1:D#", M = "IF(ISNA(MATCH(#,¤,0)),1,0)"
        Dim Rg(1 To 2) As Range, V, R&, W, X, Y
        Set Rg(1) = Sheet1.[A1].CurrentRegion.Columns
        Set Rg(2) = Sheet2.[A1].CurrentRegion.Columns
        V = Rg(2).Parent.Evaluate(Replace(Replace(M, "#", Rg(2)(3).Address), "¤", Rg(1)(3).Address(, , , True)))
    With Application
        R = .Sum(V)
       .ScreenUpdating = False
    If R Then
        R = Rg(2).Rows.Count - R + 1
        Rg(2)(5).Value2 = V
        Rg(2).Resize(, 5).Sort Rg(2)(5), 1, Header:=1
        Union(Rg(2).Rows(R & ":" & Rg(2).Rows.Count), Rg(2)(5)).Clear
        Set Rg(2) = Rg(2).Resize(R - 1)
    End If
        W = [{3,44}]
        V = Rg(1).Parent.Evaluate(Replace(Replace(Replace(M, "1", W(2)), "#", Rg(1)(3).Address), "¤", Rg(2)(3).Address(, , , True)))
        X = Rg(1).Parent.Evaluate(Replace(C, "#", Rg(1).Rows.Count))
        Y = Rg(2).Parent.Evaluate(Replace(C, "#", Rg(2).Rows.Count))
    For R = 2 To UBound(V)
        If V(R, 1) = 0 Then If IsError(.Match(X(R, 1), Y, 0)) Then V(R, 1) = W(1)
    Next
    If .Sum(V) Then
            Rg(1)(5).Value2 = V
        For Each X In W
            If IsNumeric(.Match(X, V, 0)) Then
                R = Rg(2).Rows.Count + 1
                Rg(1)(5).AutoFilter 1, X
                Rg(1).Offset(1).Copy Rg(2).Cells(R, 1)
                Set Rg(2) = Rg(2).CurrentRegion
                Rg(2).Rows(R & ":" & Rg(2).Rows.Count).Font.ColorIndex = X
            End If
        Next
            Rg(1)(5).AutoFilter
            Rg(1)(5).Clear
    End If
       .ScreenUpdating = True
    End With
        Erase Rg
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[Faseeh]

This is working like a magic!! I am still trying to understand how it is done.

Please explain it a little!

 

[Marc L]

As you can see in both constants some Excel basics formulas are used for Concatenating like for Matching …​

A Range array variable is used for each worksheet data.​

The array variable V contains the evaluation of each row of Sheet2 (Ledger) for deletion : 0 = keep so obviously 1 = delete …​

Like when using an advanced filter column C headers between worksheets must be exactly the same or the procedure should be amended.​

​

The variable R contains how many rows to delete so the block If R Then … End If is the deletion part​

just clearing all the rows at once after a sort on a temp helper column according to the variable V content​

as it could be faster than deleting row-by-row in particular on big huge large data whatever …​

​

The array variable W contains the color index of each case according to your points 4 & 5 so red & orange.​

The array variable V contains a new evaluation for each row of Sheet1 (Source) according to these points​

so after the loop the value is different than zero (red or orange color index) if the row must be copied to Sheet2 …​

The array variables X and Y contain the rows concatenation of both worksheets.​

​

The block If .Sum(V) Then … End If is the copy part when necessary,​

filtering each color index on a temp helper column according to the variable V content …​

​

 

[Faseeh]

Thank you so much for this explanation. What if I want to add more columns to right? Which part i need to adjust to accommodate more columns? I think that the following constant needed to be updated for more columns:

Const C = "A1:A#&""¤""&B1:B#&""¤""&C1:C#&""¤""&D1:D#", M = "IF(ISNA(MATCH(#,¤,0)),1,0)"

 

[Marc L]

Yes the constant C must be updated like the helper column # …​

​

Another way on recent Excel versions is to use the worksheet function TEXTJOIN.​

Another way whatever the version is to loop on each row in order to concatenate via the VBA text function Join.​

​

I used the beginner formula way according to your attachment with few columns and as it seems you are under Excel 2007 version …​

​

 

[Marc L]

A new VBA demonstration whatever the columns # without any issue if the headers names are different :​

Sub Demo2()
      Const M = "IF(ISNA(MATCH(#,¤,0)),1,0)"
        Dim Rg(1 To 2) As Range, C%, V, R&, S$(), W, X
        Set Rg(1) = Sheet1.[A1].CurrentRegion.Columns
        Set Rg(2) = Sheet2.[A1].CurrentRegion.Columns:  If Rg(1).Count - Rg(2).Count Then Beep: Erase Rg: Exit Sub
        C = Rg(2).Count + 1
        V = Rg(2).Parent.Evaluate(Replace(Replace(M, "#", Rg(2)(3).Address), "¤", Rg(1)(3).Address(, , , True)))
        V(1, 1) = 0
    With Application
        R = .Sum(V)
       .ScreenUpdating = False
    If R Then
        R = Rg(2).Rows.Count - R + 1
        Rg(2)(C).Value2 = V
        Rg(2).Resize(, C).Sort Rg(2)(C), 1, Header:=1
        Union(Rg(2).Rows(R & ":" & Rg(2).Rows.Count), Rg(2)(C)).Clear
        Set Rg(2) = Rg(2).Resize(R - 1)
    End If
        ReDim S(2 To Rg(2).Rows.Count)
        For R = 2 To Rg(2).Rows.Count:  S(R) = Join$(.Index(Rg(2).Rows(R).Value2, 1, 0)):  Next
        W = [{3,44}]
        V = Rg(1).Parent.Evaluate(Replace(Replace(Replace(M, "1", W(2)), "#", Rg(1)(3).Address), "¤", Rg(2)(3).Address(, , , True)))
        V(1, 1) = 0
    For R = 2 To Rg(1).Rows.Count
        If V(R, 1) = 0 Then If IsError(.Match(Join$(.Index(Rg(1).Rows(R).Value2, 1, 0)), S, 0)) Then V(R, 1) = W(1)
    Next
    If .Sum(V) Then
            Rg(1)(C).Value2 = V
        For Each X In W
            If IsNumeric(.Match(X, V, 0)) Then
                R = Rg(2).Rows.Count + 1
                Rg(1)(C).AutoFilter 1, X
                Rg(1).Offset(1).Copy Rg(2).Cells(R, 1)
                Set Rg(2) = Rg(2).CurrentRegion
                Rg(2).Rows(R & ":" & Rg(2).Rows.Count).Font.ColorIndex = X
            End If
        Next
            Rg(1)(C).AutoFilter
            Rg(1)(C).Clear
    End If
       .ScreenUpdating = True
    End With
        Erase Rg
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[Faseeh]

Thank you so much, Mark! This is really helpful.