Help needed to add few more functionality to the current code.

[Jagdev Singh]

Hi Experts
I need your help to add few more functionality in the below code. The code is working well. I have created the macro excel file with this code. The code helps me to move specific column data from one sheet to another in the macro file. What I have to do here is copy the Raw data from the master sheet file and place it in the Raw tab of the macro file and run it. The result gets saved in the next tab named “Result” in the macro file.
Is it possible to open this macro file first and then open the master sheet from which the Raw data is used instead of coping it and pasting it in the macro file. I mean the code should directly refer to the master sheet raw data tab as an input and create a new workbook and place all the output in it.
Please let me know if this is possible.

Sub CopyColumnByTitle()
Application.ScreenUpdating = False
Sheets("Result").Cells.ClearContents
Range("G2:O60000").Interior.ColorIndex = 0
ActiveWorkbook.Worksheets("Raw").Activate
 
Dim SearchCols(14) As String
SearchCols(0) = "Facility_name"
SearchCols(3) = "Country"
SearchCols(4) = "TSI"
SearchCols(5) = "Currency"
SearchCols(6) = "Cyclone"
SearchCols(7) = "Drought"
SearchCols(8) = "Earthquake"
SearchCols(9) = "Fire"
SearchCols(10) = "Flood"
SearchCols(11) = "Landslide"
SearchCols(12) = "Lightning"
SearchCols(13) = "Storm Surge"
SearchCols(14) = "Tsunami"
 
 
'continue with all the column names
Dim i As Integer
'Find "Entity" in Row 1
With Sheets("Raw").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("Result").Range("A1").Value = "" Then
                pasteCol = 1
            Else
                pasteCol = Sheets("Result").Cells(1, .Columns.Count).End(xlToLeft).Offset(0, 1).Column
            End If
         
            .Columns(t.Column).EntireColumn.Copy _
            Destination:=Sheets("Result").Cells(1, pasteCol)
        Else
            MsgBox SearchCols(i) & " Not Found"
        End If
    Next
End With
 
Application.ScreenUpdating = True
 
End Sub

Regards,
JD

 

[Jagdev Singh]

Hi Experts

I somehow managed to modify the code and getting the desire result.

I also want to convert the excel file into PDF - that is possible with the below code

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="I:\Core team\PDF Output Reference" & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=False, _
    IgnorePrintAreas:=True, OpenAfterPublish:=False

The entire data is not getting fit into one PDF page. The last 3 columns are getting moved to another page. Is there anyway to set the scale of the excel to "Fit all columns on one page"

Regards,
JD

 

[Jagdev Singh]

Hi Experts

I fixed this issue with the help of Mr. Google.

Regards,
JD