• 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.

Match row and column header and copy data

Thomas Kuriakose

Active Member
Respected Sirs,

There are two worksheets in the attached workbook, one is "Entry" and the other is "Final".

There is input data in worksheet "Entry" from range C86 to D161 and this range can vary based on selection in the other data fields marked in grey and has not been shown. There are two columns of data with header "Number" (C85) and "Month"(D85). The rows below have data for number and the text assigned to each number.

The Final worksheet has the header with "Number"(A1) and "Months"(B1:M1) in columns.

The requirement is to lookup the "Number" and "Month" from "Entry" worksheet and match the row in which "Number is present in the "Final" worksheet and then match the column header which has the month and copy the text from "Entry" worksheet" to this cell. This has to be repeated for all the numbers in the Entry worksheet which has a matching "Number" in the "Final" worksheet

We do not want a formula based solution as the texts will vary month on month and the number will also not be the same every month and this will replace the data in the "Final" worksheet.

I found the below code but is keeps running and after a while stops without giving any results.

Code:
Sub CopyData()
    Dim iRowHeader As Integer, iColHeader As Integer
    Dim rngSrc As Range, rngDest As Range, celSrc As Range, celDest As Range
    
    iRowHeader = 2
    iColHeader = 1

        Set rngSrc = .Worksheets("Entry").Range("$D$86:$D$1000")
        Set rngDest = .Worksheets("Final").Range("$B$2:$M$1248")
        
        For Each celDest In rngDest
            For Each celSrc In rngSrc
            
                If .Worksheets("Entry").Cells(celSrc.Row, iColHeader).Value = .Worksheets("Final").Cells(celDest.Row, iColHeader).Value And _
                   .Worksheets("Entry").Cells(iRowHeader, celSrc.Column).Value = .Worksheets("Final").Cells(iRowHeader, celDest.Column).Value Then
                   celDest.Value = celSrc.Value
                End If
            Next celSrc
        Next celDest
    End With
End Sub

Thank you very much for your guidance and support always,

with regards,
thomas
 

Attachments

  • Book1.xlsm
    38 KB · Views: 3
Hello, according to your attachment an Excel basics formula VBA demonstration without any useless object variable :​
Code:
Sub Demo1()
    With Sheet2.[A1].CurrentRegion.Rows
              C = Application.Match(Sheet1.[D85].Value2, .Item(1), 0):  If IsError(C) Then Beep: Exit Sub
        With .Cells(2, 1).Resize(.Count - 1)
             .Columns(C) = Application.IfError(Application.VLookup(.Cells, Sheet1.[C85].CurrentRegion, 2, False), "")
        End With
    End With
End Sub
Do you like it ? So thanks to click on bottom right Like !​
 
Respected Sir,

My bad, thank you so much for this simplified basic code. It works perfectly.

Highly appreciate the immediate support on this query,

with regards,
thomas
 
TEBV rule as always, just reproducing what any beginner can operate using Excel basics features like here formulas …​
 
Back
Top