How to copy data from one column to another based on column header

[manatee2000]

Hello All. I need a little guidance.

I am trying to copy the data from a column to another column based on the month selected.

Here is what I have:

TableA=Contains the data (single column) to be copied

TableB=A table (12 columns for each month) with the column month name as the header

Validation List=contains pop-up list with the month name.

If the Validation List reads "Jan", I want to copy the data in TableA to the column in TableB with the matching header.

The only kicker here is that I need past data to be retained. Is this a candiate for a macro? I prefer not using a macro, but am open to anything.

 

[GK039]

Hi,

Assume your Table A starts at A1 (header). Cell B1 houses the data validation list with the months. Cells from E1 to P1 houses the month names.

Alt + F11 to open the VBE and then copy and paste the following code

Sub copydata()
Dim i As Long           'last row in column A
Dim k As Integer        'start month counter
Dim j As Integer        'last column for month counter
Dim DynaLRow As Integer 'Dynamic changing last row after copying data

Application.ScreenUpdating = False
On Error GoTo errhelp

DynaLRow = 0
i = Range("a1").End(xlDown).Row
j = Range("e1").End(xlToRight).Column
    For k = 5 To j
        If Range("b1").Value = Cells(1, k).Value Then   'if find a match
            If IsEmpty(Cells(2, k)) Then
                Range("a2:a" & i).Copy Destination:=Cells(2, k)
            Else
                DynaLRow = Cells(1, k).End(xlDown).Offset(1, 0).Row
                Range("a2:a" & i).Copy Destination:=Cells(DynaLRow, k)
            End If
        End If
    
    Next k
 Application.ScreenUpdating = True
 
errhelp:

MsgBox Err.Description
End Sub

The code assumes that the ranges are the one for my example. Change accordingly

Hope it helps

George

 

[manatee2000]

Thank you George. I updated the script as follows:

Sub copydata()
Dim i As Long           'last row in column A
Dim k As Integer        'start month counter
Dim j As Integer        'last column for month counter
Dim DynaLRow As Integer 'Dynamic changing last row after copying data
Application.ScreenUpdating = False
On Error GoTo errhelp
DynaLRow = 0
i = Range("c11").End(xlDown).Row
j = Range("R34").End(xlToRight).Column
    For k = 5 To j
        If Range("v1").Value = Cells(1, k).Value Then   'if find a match
            If IsEmpty(Cells(2, k)) Then
                Range("a2:a" & i).Copy Destination:=Cells(2, k)
            Else
                DynaLRow = Cells(1, k).End(xlDown).Offset(1, 0).Row
                Range("a2:a" & i).Copy Destination:=Cells(DynaLRow, k)
            End If
        End If
    
    Next k
 Application.ScreenUpdating = True
 
errhelp:
MsgBox Err.Description
End Sub

However, when I run it, I get no result and a blank message box.

To be more specific (I had not expected a solutions so quickly) the structure of the worksheet is:

TableA = C4:C11

TableB = G27:R34

Validation List is V1

Did I edit the script correctly?

Thank you for the time and efforts.

 

[GK039]

Copy this

Sub copydata()
Dim i As Long           'last row in column A
Dim k As Integer        'start month counter
Dim j As Integer        'last column for month counter
Dim DynaLRow As Integer 'Dynamic changing last row after copying data

Application.ScreenUpdating = False
On Error GoTo errhelp

DynaLRow = 0
i = Range("c4").End(xlDown).Row
j = Range("g27").End(xlToRight).Column
    For k = 7 To j
        If Range("v1").Value = Cells(27, k).Value Then   'if find a match
            If IsEmpty(Cells(28, k)) Then
                Range("c5:c" & i).Copy Destination:=Cells(28, k)
            Else
                DynaLRow = Cells(27, k).End(xlDown).Offset(1, 0).Row
                Range("c5:c" & i).Copy Destination:=Cells(DynaLRow, k)
            End If
        End If
    
    Next k
 Application.ScreenUpdating = True
 
Exit Sub
errhelp:

MsgBox Err.Description
End Sub