VBA Help to find a column based on header value and cupy it to an other worksheet

0 votes

I have a simple program that I may use to copy the necessary table columns to another worksheet. My issue is that every time I try to edit it such that the header isn't copied and pasted, an error is returned. Here's my code:

Sub CopyColumns()

    Dim wsSource, wsResult As Worksheet
    Dim Name, UniqueId, OperatingStatus As Long
       
    Set wsSource = ThisWorkbook.Sheets("Source")
    Set wsResult = ThisWorkbook.Sheets("Result")
    
    Name = wsSource.Rows(1).Find("#BASEDATA#name").Column
    UniqueId = wsSource.Rows(1).Find("#BASEDATA#uniqueId").Column
    OperatingStatus = wsSource.Rows(1).Find("#BASEDATA#operatingStatus").Column
    
    If Name <> 0 Then
        wsSource.Columns(Name).Copy Destination:=wsResult.Columns(3)
    End If
    If UniqueId <> 0 Then
        wsSource.Columns(UniqueId).Copy Destination:=wsResult.Columns(4)
    End If
    If OperatingStatus <> 0 Then
        wsSource.Columns(OperatingStatus).Copy Destination:=wsResult.Columns(1)
    End If
    
End Sub

Any ideas on how to solve it? I tried to copy it like this using offset:

If targetColName <> 0 Then
wsSource.Columns(targetColName).Offset(1, 0).Resize(wsSource.Rows.Count - 1).Copy _ Destination:=wsResult.Columns(3).Offset(1, 0)

It gives Error: Application-defined or object-defined error

Jan 26 in Others by Kithuzzz
• 34,760 points
112 views

1 answer to this question.

0 votes

You can break out the "copy column if found" into a separate sub:

Sub CopyColumns()

    Dim wsSource, wsResult As Worksheet
    
    Set wsSource = ThisWorkbook.Sheets("Source")
    Set wsResult = ThisWorkbook.Sheets("Result")
    
    CopyIfExists wsSource.Rows(1), "#BASEDATA#name", wsResult, 3
    CopyIfExists wsSource.Rows(1), "#BASEDATA#uniqueId", wsResult, 4
    CopyIfExists wsSource.Rows(1), "#BASEDATA#operatingStatus", wsResult, 1
    
End Sub

'Look for `colName` in `headerRow`, and if found copy the whole
'  column to column `destColNum` on `destSheet`
Sub CopyIfExists(headerRow As Range, colName As String, destSheet As Worksheet, destColNum As Long)
    Dim f As Range
    Set f = headerRow.Find(what:=colName, lookat:=xlWhole) 'or xlPart
    If Not f Is Nothing Then
        f.EntireColumn.Copy destSheet.Cells(1, destColNum)
    End If
End Sub
answered Jan 26 by narikkadan
• 59,740 points

Related Questions In Others

0 votes
1 answer

How do I get it to select a single row based on the value?

Try this: Sub MoveBasedOnValue2() Dim ...READ MORE

answered Jan 20 in Others by narikkadan
• 59,740 points
71 views
0 votes
1 answer
0 votes
1 answer

I want to make Excel read a value in Calc and copy it to my sheet in Excel

Here is the sample code that will allow ...READ MORE

answered Oct 27, 2022 in Others by narikkadan
• 59,740 points
101 views
0 votes
1 answer

Retrieve epay.info Balance with VBA and Excel

This code should log you in, provided ...READ MORE

answered Sep 5, 2018 in Blockchain by digger
• 26,740 points
575 views
0 votes
1 answer

How to load file to Excel Power query from SFTP site

Currently, I don't think there is a ...READ MORE

answered Dec 3, 2018 in Power BI by Upasana
• 8,620 points
2,551 views
0 votes
1 answer

Using VBA Excel to create a gramatically correct list

The Excel AND function is a logical ...READ MORE

answered Feb 9, 2022 in Others by gaurav
• 22,970 points
148 views
0 votes
2 answers

How to copy a formula horizontally within a table using Excel VBA?

Hi so basically, create an adjacent column ...READ MORE

answered Feb 16, 2022 in Others by Edureka
• 13,630 points
391 views
0 votes
1 answer

How to find a value in an excel column by vba code Cells.Find

Just use: Dim Cell As Range Columns("B:B").Select Set cell = ...READ MORE

answered Nov 17, 2022 in Others by narikkadan
• 59,740 points
782 views
0 votes
1 answer

VBA Loop to select then copy a range of cells based on value in column B

Try this: Sub Macro2() Dim ...READ MORE

answered 4 days ago in Others by narikkadan
• 59,740 points
22 views
webinar REGISTER FOR FREE WEBINAR X
REGISTER NOW
webinar_success Thank you for registering Join Edureka Meetup community for 100+ Free Webinars each month JOIN MEETUP GROUP