• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Copy Data by month to table using Inputbox with Add or Delete Row

One more thing is, How to modify in code that Inserting Entire Row instead Inserting Row only for Some Columns.

Code: 
If UBound(W) > .Count - 2 Then .Item(3).Resize(UBound(W) - .Count + 2).Insert
 
To update :​
Code: 
    With [RawTable]
           .Sort .Cells(1), 1, Header:=1
            V = Evaluate(Replace("IF(#,""Diff_""&TEXT(#,""mmmm""))", "#", .Columns(1).Resize(.Rows.Count + 1).Address))
        For L = 1 To UBound(V) - 1
                F = L
                While V(L, 1) = V(L + 1, 1):  L = L + 1:  Wend
                W = .Rows(F & ":" & L)
 
Thank you Marc.

Code is working Great. I have added another data also with this code and working both, but need one more help. (Paste row if "Date" and "Emp Code" match with RawData and if not match then paste in "No_Match" (after March month))
81875

81876


Before it, please advice me that I have to open new post or continue here, and where is Mark as Solved option in forum?
 

Attachments

  • RecoSheet.xlsm
    45.6 KB · Views: 4
CemHyur said:
Paste row if "Date" and "Emp Code" match with RawData and if not match then paste in "No_Match"
Click to expand...
According to this explanation I can't reproduce the same result so which is wrong, the explanation, the result or both ?​
If the result so share at least a worksheet result without any error (3 errors in April, 2 in May and so on …).​
​
 
Still an error in April so the same in Not Match … Anyway :​
Code: 
Private Sub Cp_Data_Click()
  Const C = "A:D"
    Dim V, Rw As Range, R&(12), M%
        V = [RawData[Date]&RawData[Emp Code]]
'       Just use a smart named range to clear the result ranges or
        Sheet2.Range("Not_Match," & Join(Evaluate("IF({1},""Reco_""&TEXT(COLUMN(A:L)&""/1"",""mmmm""))"), ",")).ClearContents
    For Each Rw In [RecoData].Rows
        If IsError(Application.Match(Rw.Cells(1).Value2 & Rw.Cells(2), V, 0)) Then
                R(0) = R(0) + 1
            With [Not_Match].Rows
                If R(0) = .Count - 1 Then .Item(R(0) + 1).Insert
               .Item(R(0) + 1).Columns(C) = Rw.Value
            End With
        Else
                M = Month(Rw.Cells(1))
                R(M) = R(M) + 1
            With Sheet2.Range("Reco_" & Evaluate("TEXT(""" & M & "/1"",""mmmm"")")).Rows
                If R(M) = .Count - 1 Then .Item(R(M) + 1).EntireRow.Insert
               .Item(R(M) + 1).Columns(C) = Rw.Value
            End With
        End If
    Next
        Application.Goto Sheet2.[A1], True
End Sub
 
Hi.

This is not pasting in Same Row. (If Didn't find match then it will Blank and paste in Not_Match Range & if find match (in A:C) then paste in same row in K:N Column)
 
So your post #31 was unclear as obviously RawData range is located in WrkingSheet !​
But you can mod the demonstration to match each Reco month range with its relative Diff range …​

CemHyur said:
if find match (in A:C)
Click to expand...
A:C ?!​
​
 
Marc L said:
RawData range is located in WrkingSheet
Click to expand...
Yes but first I'll paste it (RawData) into Diff_Month Ranges, and then I want to paste RecoData to Reco_Month Ranges, but first it'll check in Date (Column B) and Emp Code (Column C) if It is match then paste RecoData row in Column K:N in same same row of B:E and if not match then paste into Not_Match Range. And if match didn't got in any row of Diff_Month Range then Then that row will keep blank in K:N. ( as I attached the file in post #33)



Marc L said:
A:C
Click to expand...
Sorry this is my typo mistake...
 
Before to try another way based on your post #33 small data attachment​
first modify Not_Match named range to be smart with just the data rows so without the header row neither the total row …​
Code: 
Private Sub Cp_Data_Click()
    Dim W, V(), R&, L&, C%
        W = Replace("B1:B#&C1:C#", "#", Sheet2.Cells(Rows.Count, 3).End(xlUp).Row)
        [Recos].ClearContents
        W = Sheet2.Evaluate("IF({1},MATCH(RecoData[Date]&RecoData[Emp Code]," & W & ",0))")
    With [RecoData].Rows
            V = .Value
        For R = 1 To .Count
            If IsNumeric(W(R, 1)) Then Sheet2.Rows(W(R, 1)).Columns("K:N") = .Item(R).Value _
                                  Else L = L + 1: For C = 1 To .Columns.Count: V(L, C) = V(R, C): Next
        Next
    End With
    If L Then
        With [Not_Match].Rows
            If L > .Count Then .Item(2).Resize(L - .Count).Insert xlShiftDown
           .Item(1).Resize(L, C - 1) = V
        End With
    End If
        Application.Goto Sheet2.[A1], True
End Sub
You should Like it !​
​
 
Hi

Thank you so much.
I have added code in my data, working fine, but got one problem that this is ignoring duplicates, means if same Date and Emp_Code present in RecoData then it will not paste in Reco_Month Range nor in Not_Match Range.

Please check here. This is RecoData on Reco Sheet.View attachment 81924


This is Diff Sheet.
View attachment 81925


So can we change it to, if Duplicates in both (Date & Emp_Code) then check Value column and paste accordingly.
 
PLEASE IGNORE POST #39

Hi,
Got one problem is code ignoring duplicates (if same Date and Emp_Code present in RecoData then it will not paste in Reco_Month Range nor in Not_Match Range)


[Update]:
So I have tried to add VALUE column also to match, for that I have modified code:
W = Replace("B1:B#&C1:C#&E1:E#", "#", Sheet2.Cells...
and here:
...IF({1},MATCH(RecoData[Date]&RecoData[Emp Code]&RecoData[Value]," & W & ",0))")

This is working fine for some data where all 3 are exactly match, but the issue is VALUE have some difference like RawData have value 1204.50 and RecoData have 1205.00 (sometime bigger difference), that's way code adding it into No_Match Range.

So can we do like this, if difference between RawData & RecoData VALUE upto 1 then code will count it as match.
and if difference goes beyond 1 then it will count as Not Match, and paste accordingly.

Modified workbook attached here.

Sorry for the trouble.
 

Attachments

  • RecoSheet.xlsm
    50.7 KB · Views: 4
Last edited:
Adding the Value to Date & Emp Code for an unique key works only with exact matching values so not such a great idea …​
And as the Emp Name does not match between ranges so the easy fast MATCH worksheet function is not the way to go !​
  1. So why this important value criteria was not elaborated in post #31 ?‼

  2. The slower classic Find Excel feature should work but how many max rows in both ranges in your real workbook ?
 
Marc L said:
So why this important value criteria was not elaborated in post #31 ?‼
Click to expand...
Because I know that majority VALUE will not match due to Decimals, that's why I thought that only find exact match will Date and Emp Code.
But after adding code to data I found that Date and Emp Code also have Duplicates.


Marc L said:
how many max rows in both ranges in your real workbook ?
Click to expand...
Max to max 500 in each Table...

I have tried and created formula for each cell K5:N#, but this is also not working, check if u can modified and convert into VBA.
=IF(AND(($B10=RecoSheet!$B9),($C10=RecoSheet!$C9),(($E10-RecoSheet!$E9)<=1)),INDEX(RecoSheet!$B$4:$E$498,MATCH($B10,RecoSheet!$B$4:$B$498,0),1),"FALSE")


I tried something like this,
If ((Diff[Date] = RecoSheet[Date]) & (Diff[Emp Code] = RecoSheet[Emp Code]) & ((Diff[Value]-RecoSheet[Value])<=1)) then
Paste row in Reco_Month Range Else
Paste in Not_Match Range

Can set difference between VALUE upto 1 than Match, If greater than 1 then not match...
 
According to your attachment the Excel basics Find feature is fast enough :​
Code: 
Private Sub Cp_Data_Click()
         Dim Rw As Range, Rf As Range, R&, L&
         Application.Calculation = xlCalculationManual
         [Recos].ClearContents
    For Each Rw In [RecoData].Rows
       Set Rf = Sheet2.UsedRange.Columns(1).Find(Rw.Cells(1))
    If Not Rf Is Nothing Then
           R = 1
      Do
        If Rf(R, 2) = Rw.Cells(2) And Abs(Rf(R, 4) - Rw.Cells(4)) < 1 And IsEmpty(Rf(R, 10)) Then _
           Rf(R, 10).Resize(, Rw.Columns.Count) = Rw.Value: Exit Do
        If Rf(R + 1) = Rw.Cells(1) Then R = R + 1 Else Set Rf = Nothing
      Loop Until Rf Is Nothing
    End If
        If Rf Is Nothing Then
            L = L + 1
            If L = [Not_Match].Rows.Count Then [Not_Match].Rows(L).Insert xlShiftDown
            [Not_Match].Rows(L).Resize(, Rw.Columns.Count) = Rw.Value
        End If
    Next
       Application.Calculation = xlCalculationAutomatic
       Application.Goto Sheet2.[A1], True
       Set Rf = Nothing
End Sub
You may Like it !​
​
 
You must log in or register to reply here.
Back
Top