VBA to copy all Columns that match a pattern

[Mrunal]

Hello,

I was hoping to get some help with a VBA code to copy ALL columns that match a pattern"parent_aggr" to another sheet (in sequence where the first column in date followed by each column that match).

Appreciate your help.

Cheers,

Modi

 

[Nebu]

Hi:

This macro is easy to code, but I have a question on pattern, I am not sure what did you meant by that, could you please elaborate.

Thanks

 

[Mrunal]

Hello,

By pattern, I mean a generic function that can accept any string to search for.
if that pattern/string is found, then we copy that entire column and paste to other worksheet one after the other.


Thanks

Modi

 

[Nebu]

Hi:

I guess you have to be more specific , what kind of string you want to search? If you search for a generic string, in the data you have given there can be multiple occurences of that string. On what basis you will decide which occurence/which column you want to copy? I guess you will have some logic behind the same can you be more specific, also the "parent_aggr" is occuring multiple times in your data.

Thanks

 

[Mrunal]

Hello,

That is exactly my challenge, I would like for each column with pattern "parent_aggr" to be copied across e.g. If there are 40 columns then we have 41 columns in the destination worksheet (Column1 = Date, Column2 ... ColumnN = pattern matched cols).

Example - The current code below only copies the first matched column while I would like for it to copy ALL matching cols.

Sub COPY_COL_FROM_PATTERN_AS_VALUES_BETWEEN_WORKSHEETS_DYNAMIC_LASTCOL(SourceWS As String, DestWS As String, ColumnPattern As String)
        Application.DisplayAlerts = False
        On Error Resume Next
      
        Worksheets(SourceWS).Activate
        SELECT_COL_FROM_PATTERN (ColumnPattern)
        Selection.Copy
        Worksheets(DestWS).Activate
        Range(GET_LAST_EMPTY_COLUMN_FROM_RANGE("A1")).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
      
        On Error GoTo 0
        Application.DisplayAlerts = True
End Sub


Function SELECT_COL_FROM_PATTERN(Pattern As String)
    ' Example - SELECT_COL_FROM_PATTERN "Timestamp"
    Dim PatternAddress As String
    PatternAddress = Cells.Find(What:=Pattern, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Address
    SELECT_COL_FROM_RANGE PatternAddress
End Function

Function GET_LAST_EMPTY_COLUMN_FROM_RANGE(FromRange As String)
    ' Example - GET_LAST_EMPTY_COLUMN_FROM_RANGE "A1"
    Dim startColNumber1, startRowNumber1 As Long
    Dim startColLetter1 As String
    startRowNumber1 = Range(FromRange).Row
    LastColNumber1 = Cells(startRowNumber1, Columns.Count).End(xlToLeft).Column + 1
    lastColLetter1 = ColumnLetter(LastColNumber1)
    GET_LAST_EMPTY_COLUMN_FROM_RANGE = lastColLetter1 & startRowNumber1
End Function

Function SELECT_COL_FROM_RANGE(FromRange As String)
    ' Example - SELECT_COL_FROM_RANGE "A2"
    Range(FromRange).Select
    Dim startColNumber, startRowNumber As Long
    Dim startColLetter As String
    startColNumber = Range(FromRange).Column
    startRowNumber = Range(FromRange).Row
    startColLetter = ColumnLetter(startColNumber)
    LastRowNumber = Range(startColLetter & Rows.Count).End(xlUp).Row
    LastColNumber = Cells(startRowNumber, Columns.Count).End(xlToLeft).Column
    LastColLetter = ColumnLetter(LastColNumber)
    Set rng = Range(startColLetter & startRowNumber & ":" & ActiveSheet.Range(startColLetter & "65536").End(xlUp).Address)
    'MsgBox rng.Address
    rng.Select
End Function

 

[Nebu]

Hi:

I am not sure whether this what you are looking for. I have coded as per my understanding. Please find the attached.

Thanks

 

[Mrunal]

Thanks mate, I am not good at programming and to be honest don't understand your code. Appreciate your help for now!

I have managed to achieve the outcome by copy / paste / autofilter (repeating)

Cheers