Help with reading suggestion or vba code

[xyga1998]

Greetings!

If anyone can help me with a VBA partial code or if anyone can tell me what to read so I can accomplish this. I can't figure out anything for the moment. The general idea is to put values of Sheet 1 column B(Type) in Sheet 2 where ID-s should match and also the rounds. I don't want to make a code for each ID (as there are a lot and may change) so it must automatically look for it like an example I found as below:

For Each cell In Sheets("Sheet2").UsedRange.Columns("A:A").Cells    If cell <> "" And cell.Row <> 1 Then
        Set roun = Sheets("Sheet1").Columns("A:A").Find(What:=cell.Value, LookIn:=xlFormulas, LookAt:=xlPart, _
                           SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)

In Sheet1 one specific ID may appear multiple times, but only once in Sheet2. The 3-rd figure shows what I need to achieve if the explanations is not good. Also I'm trying to avoid formulas in cells.

Any suggestions?

​

 

[MartyS]

If anyone can help me with a VBA partial code

Here's a finished product: Let me know if it's what you were looking for.

https://www.dropbox.com/s/t8x55t7j08b2w8f/MoveData.xlsm?dl=0


Using the pictures you pasted as a template (i.e. ID's in column A, starting at row 2 with headers in Row 1, etc)... this code should do the job.

It will also capture and place in column L (in the Target Sheet) any information it finds in the first table that doesn't match the second table..

For example:

If ID = 09090 in Table 1 and there is no ID 09090 in Table 2, the data can't be placed there, so an error detailing this is listed in column L of the Target sheet
If ID = 00001 in Table 1 with a "Round" of 11... 11 can't be found in Table 2 (only goes up to 9), so an error detailing this is listed in column L of the Target sheet

Hope that helps!

Here's the code I created to do this.

For ease of use I made it so it's easy to change the Source sheet name, Target sheet name, Error Information column, etc in the CONSTS at the beginning of the code.

Sub DoIt()


    Const SrcSheet = "Sheet1"
    Const TgtSheet = "Sheet2"
    
    Const DataStartCell = "A2"
    Const LastCol = "F"
    
    Const DMR = 1048576          'Excel MAX row - do not alter
    Const DMC = 16384            'Excel MAX col - do not alter
    
    Const ErrCol = "L"            'The column in the Target sheet where the Error information appears


    Dim LastRow As Integer, nLastCol As Integer
    Dim TgtLastRow As Integer
    Dim DSR As Integer, DSC As Integer 'DSR = Data Start Row, DSC = Data Start Column
    Dim RCntr As Integer, CCntr As Integer
    Dim LookupCode As String
    Dim WhatToPlace As String
    Dim WhereToPlaceRef As Integer
    Dim WhereToPlaceRefSTR As String
    Dim rWhereToPlace As Integer, cWhereToPlace As Integer
    Dim ErrRow As Integer, ErrCnt As Integer, ErrFound As Boolean, nErrCol As Integer
    
    'Get the DSR and DSC
    DSR = ActiveSheet.Range(DataStartCell).Row
    DSC = ActiveSheet.Range(DataStartCell).Column
    nErrCol = ActiveSheet.Range(ErrCol & 1).Column
    
    'Get the last col number
    nLastCol = ActiveSheet.Range(LastCol & "1").Column
    
    'Get the last row of data in column A of the Source Sheet
    LastRow = Sheets(SrcSheet).Range(Cells(DSR, DSC).Address, Cells(DMR, DSC).Address).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    'Get the last row of data in column A of the Target Sheet
    TgtLastRow = Sheets(TgtSheet).Range(Cells(DSR, DSC).Address, Cells(DMR, DSC).Address).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    ErrRow = 1
    ErrCnt = 0
    
    
    'Go through each Row of Data in the Source Sheet
    For RCntr = DSR To LastRow
        For CCntr = DSC To nLastCol
        
            Select Case CCntr
                Case 1
                    LookupCode = Sheets(SrcSheet).Range(Cells(RCntr, CCntr).Address).Value
                Case 2
                    WhatToPlace = Sheets(SrcSheet).Range(Cells(RCntr, CCntr).Address).Value
                Case Else
                    
                    WhereToPlaceRef = Sheets(SrcSheet).Range(Cells(RCntr, CCntr).Address).Value
                    WhereToPlaceRefSTR = Sheets(SrcSheet).Range(Cells(RCntr, CCntr).Address).Value
            
                    If Len(Trim(WhereToPlaceRefSTR)) > 0 Then
                    
                        On Error Resume Next
                        rWhereToPlace = Application.WorksheetFunction.Match(LookupCode, Worksheets(TgtSheet).Columns(1), 0)
                        If Err.Number <> 0 Then
                            On Error GoTo 0
                            'ROW MATCH NOT FOUND - The ID doesn't exist in the table on the Target Sheet (ID numbers in column A)
                            ErrRow = ErrRow + 1
                            Sheets(TgtSheet).Range(ErrCol & ErrRow).Value = "[" & LookupCode & "] ID not found"
                            ErrFound = True
                            ErrCnt = ErrCnt + 1
                            Sheets(TgtSheet).Range(Cells(1, nErrCol).Address).Value = ErrCnt & " Matches Not Found"
                        End If
                        On Error GoTo 0
                        
                        On Error Resume Next
                        cWhereToPlace = Application.WorksheetFunction.Match(WhereToPlaceRef, Worksheets(TgtSheet).Rows(1), 0)
                        If Err.Number <> 0 Then
                            On Error GoTo 0
                            'COL MATCH NOT FOUND - The ROUND doesn't exist in the table on the Target Sheet (column headers in ROW 1)
                            ErrRow = ErrRow + 1
                            Sheets(TgtSheet).Range(ErrCol & ErrRow).Value = "[" & WhatToPlace & "] not found for ID " & LookupCode
                            ErrFound = True
                            ErrCnt = ErrCnt + 1
                            Sheets(TgtSheet).Range(Cells(1, nErrCol).Address).Value = ErrCnt & " Matches Not Found"
                        End If
                        On Error GoTo 0
                        
                        If ErrFound = False Then
                            Sheets(TgtSheet).Range(Cells(rWhereToPlace, cWhereToPlace).Address).Value = WhatToPlace
                          Else
                            ErrFound = False
                        End If
                    End If
                    
            End Select
            
        Next CCntr
    Next RCntr
    
    
'#####################################################
'
'    VBA MATCH FORMULAE USED ARE AS FOLLOWS
'
'    RowNum = =MATCH(C2,Sheet2!$A$1:$J$1,0)
'    ColNum = =MATCH(A2,Sheet2!$A$1:$A$20,0)
'
'#####################################################
    
End Sub

 

[mumps]

Try:

Sub xyga1998()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim lCol As Long
    Dim rng As Range, rng2 As Range
    Dim foundVal As Range, foundVal2 As Range
    For Each rng In Sheets("Sheet1").Range("A2:A" & LastRow)
        lCol = Sheets("Sheet1").Cells(rng.Row, Columns.Count).End(xlToLeft).Column
        Set foundVal = Sheets("Sheet2").Range("A:A").Find(rng, LookIn:=xlValues, lookat:=xlWhole)
        If Not foundVal Is Nothing Then
            For Each rng2 In Sheets("Sheet1").Range(Cells(rng.Row, 3), Cells(rng.Row, lCol))
                Set foundVal2 = Sheets("Sheet2").Rows(1).Find(rng2, LookIn:=xlValues, lookat:=xlWhole)
                If Not foundVal2 Is Nothing Then
                    Sheets("Sheet2").Cells(foundVal.Row, foundVal2.Column) = rng.Offset(0, 1)
                End If
            Next rng2
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[xyga1998]

Here's a finished product: Let me know if it's what you were looking for.

Thank you very much. It is exactly what I was looking for

 

[xyga1998]

Try:

Thank you very much

 

[mumps]

Glad to help.