CODEWITHSUNDEEP
vbaexcel
Stephanie
Stephanie

Reputation: 1

Code for pasting data based on Row and Column matching Value condition

I have two sheet tabs.i.e. Raw Data and Overview

I was looking for code which would copy and paste data in the Overview tab based on the names in Column B and dates in row 3:3.

The table in Raw Data tab has names in column A, dates in Column B and Value in Column C

The table in Overview looks like this

  01/04/2015 02/04/2015 03/04/2015  04/04/2015  05/04/2015

a
b
c
d

I understand that there are formulas like Vlookups, Index, sumifs but I would prefer the solution in VBA as the data is extensive

Upvotes: 0

Views: 782

Answers (1)

Abe
Abe

Reputation: 274

As a matter of example only, please check the code below, it has sections that create things for you. It should work for your problem, but certainly is not using the best practices specially while looking at the performance side of the problem.

To run this code, you have to check and modify the worksheet names in the two code lines starting with "Set" and change the column and row indexers to fit your needs.

Also, it is important to say that, if you have repeated values on your first two columns, this procedure might not work as expected.

Sub DoYourJob()

Dim x As Integer
Dim y As Integer
Dim z As Integer

Dim sourceWorksheet As Worksheet
Dim targetWorksheet As Worksheet

Set sourceWorksheet = ThisWorkbook.Worksheets("YourSourceWorksheetName")
Set targetWorksheet = ThisWorkbook.Worksheets("YourTargetWorksheetName")

Dim existing As Boolean
'Let the macro read an create the table

'Creating the rows
For x = 2 To sourceWorksheet.Cells(sourceWorksheet.Rows.Count, 1).End(xlUp).Row
    existing = False
    For y = 2 To targetWorksheet.Cells(targetWorksheet.Rows.Count, 1).End(xlUp).Row
        If targetWorksheet.Cells(y, 1).Value = sourceWorksheet.Cells(x, 1).Value Then
            existing = True
            Exit For
        End If
    Next y
    If Not existing Then
        targetWorksheet.Cells(targetWorksheet.Cells(targetWorksheet.Rows.Count, 1).End(xlUp).Row + 1, 1).Value = sourceWorksheet.Cells(x, 1).Value
    End If
Next x

'Creating the columns
For x = 2 To sourceWorksheet.Cells(sourceWorksheet.Rows.Count, 1).End(xlUp).Row
    existing = False
    For y = 2 To targetWorksheet.Cells(1, targetWorksheet.Columns.Count).End(xlToLeft).Column
        If targetWorksheet.Cells(1, y).Value = sourceWorksheet.Cells(x, 2).Value Then
            existing = True
            Exit For
        End If
    Next y
    If Not existing Then
        targetWorksheet.Cells(1, targetWorksheet.Cells(1, targetWorksheet.Columns.Count).End(xlToLeft).Column + 1).Value = sourceWorksheet.Cells(x, 2).Value
    End If
Next x

'Iterate to fill the table
For z = 1 To sourceWorksheet.Cells(sourceWorksheet.Rows.Count, 1).End(xlUp).Row
    For y = 2 To targetWorksheet.Cells(targetWorksheet.Rows.Count, 1).End(xlUp).Row
        If targetWorksheet.Cells(y, 1).Value = sourceWorksheet.Cells(z, 1).Value Then
            For x = 2 To targetWorksheet.Cells(1, targetWorksheet.Columns.Count).End(xlToLeft).Column
                If targetWorksheet.Cells(1, x).Value = sourceWorksheet.Cells(z, 2).Value Then
                    targetWorksheet.Cells(y, x).Value = sourceWorksheet.Cells(z, 3).Value
                    Exit For
                End If
            Next x
            Exit For
        End If
    Next y
Next z

End Sub

If you have trouble understanding or using the code, please leave a comment.

Upvotes: 0

Related Questions