Solved

Copy matched data

Posted on 2011-03-10
10
186 Views
Last Modified: 2012-05-11
Hi Experts,

I would like to request Experts help create a macro to copy and paste data from “Sheet2” into “Matched” sheet if the data at “Sheet1” (table 1 to table 2)  is matched. I have attached the sample data at Match sheet for Experts to get better view. Hope Experts will help me to create this feature.



DataCheck.xls
0
Comment
Question by:Cartillo
  • 6
  • 4
10 Comments
 
LVL 6

Expert Comment

by:royhsiao
ID: 35097991
1) Is data in sheet 1 unique?
2) Is type and number in sheet 2 unique?
3) What will you do with duplicated data?
3) Is it ok to reduce the number of columns to 2 all sheets?
0
 

Author Comment

by:Cartillo
ID: 35100835
Hi Roy,

Sorry for the confusion. we need to crosscheck first 5 latter from columns "Type" at sheet2. If the data is matched with sheet 1 then we need to copy the whole data from sheet 2 (number + type) to Matched sheet. E.g. crosscheck data "ATZDI" (sheet1), 4 data are found at sheet2:

571479      ATZDI01HS11A
571479      ATZDI01HS11B
572599      ATZDI01HS11B
573150      ATZDI01HS11A

And, the data need to copy at Matched sheet.

All data at sheet1 are unique, but data at sheet 2 not so. Some time we do have same "Number" but with different "Type" Data. The reason we have more rows at Matched sheet is, I'm having humungous data that need to cross checked.

Hope I've answered your Q.  
0
 
LVL 6

Expert Comment

by:royhsiao
ID: 35108485
ok try this
Sub test()
Dim i As Integer
Dim j As Integer
Dim m As Integer
Dim id_end_row As Integer
Dim id_str As String
Dim type_str As String
Dim type_str2 As String
m = 2

Worksheets("sheet1").Activate
Range("A65536").Select
Selection.End(xlUp).Select
id_end_row = ActiveCell.Row

Worksheets("sheet2").Activate
Range("B65536").Select
Selection.End(xlUp).Select
type_end_row = ActiveCell.Row

    For i = 2 To id_end_row
        'id_str = Worksheets("sheet1").Cells(i, 1).Value
        id_str = Worksheets("Sheet1").Range("A" & i & "").Value
            
        For j = 2 To type_end_row
            type_str = Worksheets("Sheet2").Range("B" & j & "").Value
            type_str2 = Left(type_str, 5)

            If id_str = type_str2 Then
            Sheets("sheet2").Select
            Range("A" & j & ":" & " B" & j & "").Select
            'Range("A2:B2").Select
            Selection.Copy
            Sheets("Matched").Select
            Range("A" & m & "").Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
            m = m + 1
            Else
            End If
        Next j
    Next i
End Sub

Open in new window

0
 
LVL 6

Expert Comment

by:royhsiao
ID: 35108518
The code only check the 1st column of the sheet 1 and first 2 column in the sheet 2. it will copy the matched data and paste it in "matched".

You will need to reduce the column for this code to work.
Please double check and let me know if there is any error
0
 
LVL 6

Expert Comment

by:royhsiao
ID: 35108533
0
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 

Author Comment

by:Cartillo
ID: 35108824
Hi Roy,

Thanks for the code. The reason I need more columns at sheet 2 and Matched is because I'm having more than 1 millions data that need to crosscheck. Is that possible to fix with 10 columns at Matched sheet, but at sheet 2 I need to maintain the columns from A:AH. One more think, I have another code, which is using "Dictionary Script", created by Experts Yong, but the problem with this script is, its not copying the right data. Perhaps you can test this code. Attached the code for your reference.    
Sub CopyData()
'Build the data dictionary
Dim oDicTmp As Object
Set oDicTmp = CreateObject("Scripting.Dictionary")

Dim nI As Integer
Dim nJ As Integer

    For nI = 1 To Range("TABLEDATA").Columns.Count
        For nJ = 1 To Range("TABLEDATA").Columns(nI).Rows.Count
            strTmp = Range("TABLEDATA").Columns(nI).Rows(nJ).Value
            If strTmp <> "" Then
                If Not (oDicTmp.Exists(strTmp)) Then
                    oDicTmp.Add strTmp, 1
                'Else
                '    oDicTmp.Item(strTmp) = oDicTmp.Item(strTmp) + 1
                End If
            End If
        Next nJ
    Next nI
 
'------------------------------
Dim oDic As Object, vOut(), vIn(), i As Long, j As Long, n As Long, p As Long, nCol As Long

'nCol = Application.InputBox("How many sets of columns for the results (each set has three columns)?", Type:=1)
nCol = 6 'The number of columns is fixed

With Sheets("Sheet2")
    On Error Resume Next
    .Rows(2).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete shift:=xlToLeft
    On Error GoTo 0
    vIn = .Range("A1").CurrentRegion.Value
End With

ReDim vOut(1 To UBound(vIn, 1) * UBound(vIn, 2), 1 To 3)

Set oDic = CreateObject("Scripting.Dictionary")

With oDic
    For i = 2 To UBound(vIn, 1)
        For j = 1 To UBound(vIn, 2) - 1 Step 2
            'strTmp = Trim(Str(vIn(i, j))) & Left(vIn(i, j + 1), 5)
            'strTmp = Left(vIn(i, j + 1), 5)
            'strTmp = vIn(i, j + 1)
            strTmp = Trim(Str(vIn(i, j))) & vIn(i, j + 1)
            If Not .Exists(strTmp) Then  'Long modified
                n = n + 1
                vOut(n, 1) = vIn(i, j)
                'vOut(n, 2) = strTmp 'Left(vIn(i, j + 1), 5)
                'vOut(n, 2) = Left(vIn(i, j + 1), 5)
                vOut(n, 2) = vIn(i, j + 1)
                .Add strTmp, 1
            End If
        Next j
    Next i
End With

p = WorksheetFunction.RoundUp(n / nCol, 0)

Dim nNextRow As Long

nNextRow = NextAvailableRow

With Sheets("Matched")
    '.UsedRange.Clear
    'With .Range("A1")
    With .Range("A" & Trim(Str(nNextRow)))
    
        If nNextRow = 1 Then
            .Resize(, 3).Value = Array("Number", "Type", "")
        End If
        
        'Long added one if statement to check if the number of rows exceed 65536 rows
        If n > 65536 Then
            MsgBox "The number of rows is " & Trim(Str(n)) & " which exceeds 65536." & vbCrLf & vbCrLf & "The process is how halted.", vbCritical + vbOKOnly, "Error"
            Exit Sub
        Else
            .Offset(1).Resize(n, 3) = vOut
        End If
        
        For j = 1 To nCol - 1
            If nNextRow = 1 Then
                .Offset(, j * 3).Resize(, 3).Value = Array("Number", "Type", "")
            End If
            .Offset(p + 1, (j - 1) * 3).Resize(n - (p * j), 3).Cut .Offset(1, j * 3)
        Next j
    End With
End With

End Sub

Function NextAvailableRow()

Dim nResult As Long
Dim nR As Long

    For nR = 1 To 65535
        If Cells(nR, 1).Value = "" Then
            If nR > 1 Then
                NextAvailableRow = nR - 1
            Else
                NextAvailableRow = nR
            End If
            Exit Function
        End If
    Next nR

NextAvailableRow = 1

End Function

Open in new window

0
 

Author Comment

by:Cartillo
ID: 35109493
Hi Roy,

You can ignore the attached code if the method is not your kind.
0
 
LVL 6

Expert Comment

by:royhsiao
ID: 35110410
sorry, today is my busy day.
If you convert the worksheet from excel 2003 to excel 2007. you would get over 1 milion rows
I will look at your code when I have a chance.

Convert to excel 2007
==
Click on the icon in the upper left corner of your worbook.
Click on Excel Options
Click on Save
Under Save Files in this Format, change to Excel Workbook (*.xlsx)
Click OK.
==
0
 
LVL 6

Accepted Solution

by:
royhsiao earned 500 total points
ID: 35117474
Try this code.
1) sheet 1: put all unique id in column A
2) sheet 2: make sure each column has same row
3) run the macro and check if it works
Sub test()
Dim i As Integer
Dim j As Integer
Dim m As Integer
Dim id_end_row As Integer
Dim id_str As String
Dim type_str As String
Dim type_str2 As String
Dim type_col As Integer
Dim A As String
Dim B As String
Dim col_address As String
Dim col_address_less_1 As String

m = 2

Worksheets("sheet1").Activate
Range("A65536").Select
Selection.End(xlUp).Select
id_end_row = ActiveCell.Row

Worksheets("sheet2").Activate
Range("B65536").Select
Selection.End(xlUp).Select
type_end_row = ActiveCell.Row

    For i = 2 To id_end_row
        'id_str = Worksheets("sheet1").Cells(i, 1).Value
        id_str = Worksheets("Sheet1").Range("A" & i & "").Value
        For type_col = 1 To 17
            For j = 2 To type_end_row
                type_str = Worksheets("Sheet2").Cells(j, type_col + type_col).Value
                type_str2 = Left(type_str, 5)
                A = Worksheets("Sheet2").Cells(j, type_col + type_col).Address
                B = Worksheets("Sheet2").Cells(j, type_col).Address
                
                If type_col + type_col < 26 Then
                col_address = Right(Left(A, 2), 1)
                col_address_less_1 = Right(Left(B, 2), 1)
                Else
                col_address = Right(Left(A, 3), 2)
                col_address_less_1 = Right(Left(B, 3), 2)
                End If
                
                    If id_str = type_str2 Then
                    Sheets("sheet2").Select
                    Range(col_address_less_1 & j & ":" & col_address & j).Select
                    Selection.Copy
                    Sheets("Matched").Select
                    Range(col_address_less_1 & m).Select
                    ActiveSheet.Paste
                    Application.CutCopyMode = False
                    m = m + 1
                    Else
                End If
            Next j
            m = 2
        Next type_col
    Next i
End Sub

Open in new window

0
 

Author Closing Comment

by:Cartillo
ID: 35146610
Hi,

Thanks a lot for the help
0

Featured Post

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

Dealing with unintended Excel Active-X resizing quirks (VBA code simulates "self correction") David Miller (dlmille) Intro Not everyone is a fan of Active-X controls in spreadsheets (as opposed to the UserForm approach, the older Form controls …
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now