VBA find function when not found

Botner · Sep 21st 2020

Hi, I have one sheet in my file named "G2N" which has column headers in a fixed order and i want to populate the rows under those columns with data from another sheet which i is called "BDOG2N".

The column headers are not in the same order in the different sheets and "BDOG2N" might have column headers that are not in the "G2N" sheet and vice versa.

I have tried to do this via VBA with the find function and running into a problem when I have a header in the "BDOG2N" which doesnt exist in the "G2N" sheet. If this happens, then i want to print/write the column header name somewhere so I can investigate this column manually once makro has completed.

Thank you

Code

Sub G2N()


MF = ActiveWorkbook.Name
Workbooks(MF).Activate


BDOG2N = ActiveSheet.Name
Sheets(BDOG2N).Select


Cells(1, 1).Select
Range(Selection, Selection.End(xlDown)).Select
MyRows = Selection.Count


Cells(1, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
MyCols = Selection.Count


For i = 1 To MyCols


Sheets(BDOG2N).Select
MyHeader = Cells(1, i)
Range(Cells(2, i), Cells(MyRows, i)).Select
Selection.Copy


Sheets("G2N").Select
Cells(1, 1).Select


Range("1:1").Find(what:=MyHeader, After:=ActiveCell, LookIn:=xlFormulas, _
lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate




MyCurrentCol = ActiveCell.Column
Cells(2, MyCurrentCol).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False


Next i




End Sub

Display More

**royUK** · Sep 21st 2020

Welcome to Ozgrid

Welcome to the Forum. Please read the Forum Rules to understand how the Forum works and why I have added Code Tags to your post

All VBA code posted in the forum must be wrapped in code tags, which you omitted, including single-line code snippets.Be sure to use them in future posts.

How to use code tags

Note: no apostrophe in the tags, just used for demonstration here.

['code]

your code goes between these tags

['/code]

Or, just highlight all of the code and press the <> in the post menu above button to add the code tags.

Thanks.

**royUK** · Sep 21st 2020

Can you attach an example workbook

dangelor · Sep 21st 2020

Possibly...

Code

Option Explicit

Sub G2N()
    Dim MyRows As Long, MyCols As Long, i As Long
    Dim MyHeader As Range, FoundCell As Range

    With ActiveSheet
        MyRows = .Cells(1, 1).End(xlDown).Row
        MyCols = .Cells(1, 1).End(xlToRight).Column
        For i = 1 To MyCols
            MyHeader = .Cells(1, i)
            Set FoundCell = Sheets("G2N").Rows(1).Find( _
                what:=MyHeader.Value, _
                LookIn:=xlFormulas, _
                lookat:=xlWhole)
            If Not FoundCell Is Nothing Then
                Range(.Cells(2, i), .Cells(MyRows, i)).Copy
                FoundCell.Offset(1).PasteSpecial Paste:=xlPasteValues
                Application.CutCopyMode = False
            Else
                'Prints to the Immediate window in the VBA editor
                Debug.Print MyHeader.Value, MyHeader.Address
            End If
        Next i
    End With
End Sub

Display More

davesexcel · Sep 21st 2020

Check it out.

Code

Sub GetRR_Done()
    Dim sh As Worksheet, ws As Worksheet
    Dim r As Long, cl As Long
    Dim Col As Range
    Dim rng As Range, c As Range
    
    Set sh = ActiveSheet
    Set ws = Sheets("G2N")
    Application.ScreenUpdating = False
    With sh
        
        r = .Cells(.Rows.Count, "A").End(xlUp).Row
        cl = .Cells(1, .Columns.Count).End(xlToLeft).Column
        Set rng = .Range(.Cells(1, 1), .Cells(1, cl))
        
        For Each c In rng.Cells
            
            Set Col = ws.Rows(1).Find(c, LookIn:=xlValues)
            
            If Not Col Is Nothing Then
            
            .Range(.Cells(2, c.Column), .Cells(r, c.Column)).Copy
            ws.Cells(2, Col.Column).PasteSpecial xlPasteValues
            Else
            .Cells(.Rows.Count, cl + 1).End(xlUp)(2) = c
            End If
        Next c
        
    End With
    
    Application.CutCopyMode = 0
    Application.ScreenUpdating = True
End Sub

Display More

Botner · Sep 22nd 2020

Example workbook attached here

**royUK** · Sep 22nd 2020

Have to tried the code examples above?

dangelor · Sep 22nd 2020

Correction...

Code

Sub G2N()
    Dim MyRows As Long, MyCols As Long, i As Long
    Dim MyHeader As Range, FoundCell As Range

    With ActiveSheet
        MyRows = .Cells(1, 1).End(xlDown).Row
        MyCols = .Cells(1, 1).End(xlToRight).Column
        For i = 1 To MyCols
            Set MyHeader = .Cells(1, i)
            Set FoundCell = Sheets("G2N").Rows(1).Find( _
                what:=MyHeader.Value, _
                LookIn:=xlFormulas, _
                lookat:=xlWhole)
            If Not FoundCell Is Nothing Then
                Range(.Cells(2, i), .Cells(MyRows, i)).Copy
                FoundCell.Offset(1).PasteSpecial Paste:=xlPasteValues
                Application.CutCopyMode = False
            Else
                'Prints to the Immediate window in the VBA editor
                Debug.Print MyHeader.Value, MyHeader.Address
            End If
        Next i
    End With
End Sub

Display More

Botner · Sep 22nd 2020

I have tried with the codes provided above as stand alone codes. (Possibly they were partial codes i should implement in my own original?)

With the code from Dangelor i run into an error on line item 11: "Object variable or with block variable not set"

With the code from Davesexcel runs well but incase there is one ore more column headers in the "BDOG2N" which doesnt exist in the "G2N" sheet. I want to print/write the column header name somewhere so I can investigate these column(s) manually once makro has completed. This can be for example in a new work book or similar. Perhaps it is already doing it but i didnt find it? The code was so elegant i dont really understand much of it..!

Botner · Sep 22nd 2020

Thanks Dangelor for updating, this works very well for me!
Appreciate the help from everyone

dangelor · Sep 22nd 2020

You're welcome!

VBA find function when not found

Participate now!

Share

Tags