Adding time and counting columns.

[haitran]

Hi everyone, I have a macro that saves selected columns from a Sheet to a new Workbook and save it as Text file. I have a few things that I want to add to the macro and not sure how should I name the Title of this thread, please forgive me if you misunderstood something.

Here is a few things I want to add but not sure how to start. I want to add 2 mandatory columns name COI and Workpackage.These 2 columns have to be always in the chosen columns. They are not from the "Input Sheet". Column COI is just the time create the new Workbook,for exp: a cell of column COI will look like this "COI (12/21 13:03)". Column Workpackage is a counting column for each row with format main. + number. For exp: main.1, main.2...

Any help would be appreciated.
Thank you very much.

P/s: I want to attach my current macro but I can't seem to find a way to do that. Anyone know how to? Thank you.

 

[NdNoviceHlp]

Hi haitran. I guess U got tired of the circular dialog. I was feeling kind of bad that after all the effort U put into it that we were unable to arrive at a solution. I decided that we would add your new "columns" COI and Workpackage to the right of the existing columns in the new workbook... they are actually blank columns with headers just waiting for data input Anyways, based on my understanding of your workbook setup, U can trial this code. It copies your wb to a new file then opens the file, re-orders the columns based on settings sheet E10: whatever&10. Maybe it will work. Good luck. Dave

Option Explicit
Sub TransferColumns()
Dim NewWb As Object, Lastrow As Long, InLastCol As Long, SetLastCol As Long
Dim SetCnt As Integer, InCnt As Integer, TempCol As Integer, Rng As Range
Dim OldWb As Object, NewWbName As String, Ofsobj As Object
'copies existing file to same folder as open workbook with file name "NewWbName". Adjust to suit.
'transfer columns of data from input sheet ("C" to whatever)of original wb to input sheet of new wb
'Columns "A" & "B" of input sheet in original wb transfered to new wb unchanged
'column order specified in original wb "settings" sheet E10:Whatever&10
'column headings and blank columns in new wb input sheet if columns don't exist in original wb
'Columns headers and blank columns provided in new wb for columns COI and Workpackage
NewWbName = "WbNewName" 'change file name to suit
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Sheets("inputfile")
Lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
InLastCol = .Cells(10, .Columns.Count).End(xlToLeft).Column
End With
With Sheets("settings")
SetLastCol = .Cells(10, .Columns.Count).End(xlToLeft).Column
End With
'copy file to new location
Set Ofsobj = CreateObject("Scripting.FileSystemObject")
Ofsobj.CopyFile ThisWorkbook.FullName, Left(ThisWorkbook.FullName, _
            Len(ThisWorkbook.FullName) - Len(ThisWorkbook.Name)) & _
            NewWbName & ".xlsm", True  'source,destination,save
'open new file
Set NewWb = Ofsobj.GetFile(Left(ThisWorkbook.FullName, _
    Len(ThisWorkbook.FullName) - Len(ThisWorkbook.Name)) & NewWbName & ".xlsm")
Set OldWb = ThisWorkbook
Workbooks.Open Filename:=NewWb
TempCol = 3
'transfer columns (with headers) to new locations in new workbook inputfile sheet
' as specified in "E10: whatever:10 of Settings sheet in original workbook
For SetCnt = 5 To SetLastCol
For InCnt = 3 To InLastCol
If UCase(OldWb.Sheets("settings").Cells(10, SetCnt).Text) = _
    UCase(OldWb.Sheets("inputfile").Cells(10, InCnt).Text) Then
With OldWb.Sheets("inputfile")
Set Rng = .Range(.Cells(10, InCnt), .Cells(Lastrow, InCnt))
End With
Rng.Copy Destination:=Workbooks(NewWb.Name).Sheets("inputfile").Cells(10, TempCol)
Application.CutCopyMode = False
TempCol = TempCol + 1
Exit For
End If
Next InCnt
'no column matches output order columns. Add header and blank column for new column
If InCnt = InLastCol + 1 Then
With Workbooks(NewWb.Name).Sheets("inputfile")
Set Rng = .Range(.Cells(10, TempCol), .Cells(Lastrow, TempCol))
End With
Rng.ClearContents
Workbooks(NewWb.Name).Sheets("inputfile").Cells(10, TempCol) = OldWb.Sheets("settings").Cells(10, SetCnt).Text
TempCol = TempCol + 1
End If
Next SetCnt
'add headers and blank columns for COI and Workpackage to right of last columns.
'clear all columns to right of last column if they exist
With Workbooks(NewWb.Name).Sheets("inputfile")
Set Rng = .Range(.Cells(10, TempCol), .Cells(Lastrow, .Cells(10, .Columns.Count).End(xlToLeft).Column))
End With
Rng.ClearContents
Workbooks(NewWb.Name).Sheets("inputfile").Cells(10, TempCol).Value = "COI"
Workbooks(NewWb.Name).Sheets("inputfile").Cells(10, TempCol + 1).Value = "Workpackage"
Workbooks(NewWb.Name).Close SaveChanges:=True
Set OldWb = Nothing
Set NewWb = Nothing
Set Ofsobj = Nothing
Application.ScreenUpdating = False
Application.DisplayAlerts = False
End Sub

 

[haitran]

Thank you for the code, I was too busy to get back to the forum. I will try the code to see how it works :D. Thanks again.