Results 1 to 3 of 3
  1. #1
    2 Star Lounger
    Join Date
    Feb 2015
    Posts
    128
    Thanks
    19
    Thanked 1 Time in 1 Post

    VBA code enhancement.

    Hi Experts the below code works fine for me. It pulls specific columns from a sheet and paste them into a different sheet. The issue is when it find same text/word in the name of another column in a sheet it picks that instead of the correct one. In such cases it follow first come first serve basis. Is it possible the code pick only those exact column whose header names are mentioned in the code. Is there any other way to deal with this.

    Code:
    Function CopyColumnByTitle()
    Application.ScreenUpdating = False
    ActiveWorkbook.Worksheets("Risk Score Result").Activate
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim SearchCols(8) As String
    SearchCols(0) = "Name"
    SearchCols(1) = "Country"
    SearchCols(2) = "State"
    SearchCols(3) = "Code"
    SearchCols(4) = "City"
    SearchCols(5) = "Address"
    SearchCols(6) = "Longitude"
    SearchCols(7) = "Latitude"
    SearchCols(8) = "TSI"
    Set ws = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count))
    ws.Name = "Temp"
    'continue with all the column names
    Dim i As Integer
    'Find "Entity" in Row 1
    With Sheets("Result").Rows(1)
        For i = LBound(SearchCols) To UBound(SearchCols)
            Set t = .Find(SearchCols(i), LookAt:=xlPart)
            'If found, copy the column to Sheet 2, Column A
           'If not found, present a message
          
            If Not t Is Nothing Then
                If Sheets("Temp").Range("A1").Value = "" Then
                    pasteCol = 1
                Else
                    pasteCol = Sheets("Temp").Cells(1, .Columns.Count).End(xlToLeft).Offset(0, 1).Column
                End If
                Intersect(Worksheets("Result").UsedRange, t.EntireColumn).Copy _
                Destination:=Sheets("Temp").Cells(1, pasteCol)
               
                '.Columns(t.Column).EntireColumn.Copy _
                Destination:=Sheets("Temp").Cells(1, pasteCol)
            Else
                MsgBox SearchCols(i) & " Not Found"
            End If
        Next
    End With
    End Function
    Regards,
    Jaggi

  2. #2
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,824
    Thanks
    135
    Thanked 482 Times in 459 Posts
    Hi Jaggi

    ..try changing
    Set t = .Find(SearchCols(i), LookAt:=xlPart)
    to
    Set t = .Find(SearchCols(i), LookAt:=xlWhole)

    ..that way, partial matches in other columns will be ignored

    zeddy

  3. The Following User Says Thank You to zeddy For This Useful Post:

    Jaggi (2016-04-04)

  4. #3
    2 Star Lounger
    Join Date
    Feb 2015
    Posts
    128
    Thanks
    19
    Thanked 1 Time in 1 Post
    Hi Zeddy,

    Fantastic!! This solved the issue.

    Regards,
    Jaggi

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •