VBA Macro for adding files in same folder and copying tabular columns

[gmkandan]

Hello,

I need your help. I am trying hard to do this. I have a work book in which the sheet - "Master list". Column D contains the master list of clients. 2nd sheet "Template" contains the master tabular column.

In the same FOLDER, I have a file created for each existing clients.

I will enter name of the client in the cell A3.

If the client name is already existing in the column D, then the file for the client should open

If the client name typed does not exist in the master list in column D, then, It should automatically create a workbook in the same FOLDER with the name of the NEW client typed in cell A3, and copy the tabular column from the sheet "Template", and save it.

Can anyone please help me to create an event macro for the same please?
I am a rookie in VBA / Macro and I am fully dependant on your support.

Thanks and regards,
gm2612

 

[JLGWhiz]

Assuming that the tabular column in sheet 'Template' is in column A. This code should be copied to the sheet code module of the Master list.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$3" Then Exit Sub
fName = Range("A3").Value
On Error GoTo Hdlr:
Workbooks.Open fName & ".xlsx"
Hdlr:
    If Err.Number > 0 Then
        Err.Clear
        Set wb = Workbooks.Add
        wb.SaveAs fName & ".xlsx"
        wb.Sheets(1).Range("A3") = fName
        Sheets("Template").Columns(1).Copy wb.Sheets(1).Range("A1")
        MsgBox "New Workbook Created for " & wb.Name
    End If
End Sub

 

[JLGWhiz]

Just realized that the column copied from 'Template' will overwrite cell A3. Try this modified version

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$3" Then Exit Sub
fName = Range("A3").Value
On Error GoTo Hdlr:
Workbooks.Open fName & ".xlsx"
Hdlr:
    If Err.Number > 0 Then
        Err.Clear
        Set wb = Workbooks.Add
        wb.SaveAs fName & ".xlsx"
        wb.Sheets(1).Range("A3") = fName
        Set rng = Sheets("Template").Range("A1", Sheets("Template").Cells(Rows.Count, 1).End(xlUp))
        Sheets("Template").rng.Copy wb.Sheets(1).Range("A4")
        MsgBox "New Workbook Created for " & wb.Name
    End If
End Sub

 

[gmkandan]

Hi JLGWhiz,

My sincere thanks to you for the support. With this code, it opens a new work book with the file name as desired. But, the location is not in the same folder. It opens a new folder in my coduments. Secondly, the tabular column in the sheet"Template" not copied. Can you please support to include these two features?



Thanks and regards,
gmkandan

Just realized that the column copied from 'Template' will overwrite cell A3. Try this modified version

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$3" Then Exit Sub
fName = Range("A3").Value
On Error GoTo Hdlr:
Workbooks.Open fName & ".xlsx"
Hdlr:
    If Err.Number > 0 Then
        Err.Clear
        Set wb = Workbooks.Add
        wb.SaveAs fName & ".xlsx"
        wb.Sheets(1).Range("A3") = fName
        Set rng = Sheets("Template").Range("A1", Sheets("Template").Cells(Rows.Count, 1).End(xlUp))
        Sheets("Template").rng.Copy wb.Sheets(1).Range("A4")
        MsgBox "New Workbook Created for " & wb.Name
    End If
End Sub

 

[JLGWhiz]

Information on the file path and tabular column location were not included in the original post. Responders to the postings cannot see the worksheets, so the information has to be provided by the individual who posts the problem. Either a good verbal description, a screen shot or a link to a share server is helpful when posting. See posting guidelines on this site for more details.

 

[gmkandan]

Hello JLGWhiz,

Greetings. I really appreciate your help and guidelines. What I mentioned is not a criticism, but expressing my urge for your help. Can you please help me with the code, if the file has to be saved in the following location?

"\\Ws1\MSE\CFM"

Thanks and regards,
gmkandan

 

[JLGWhiz]

this should cure the directory problem, but the tabular column is still a mystery. The ;Set rng statement is where that column would be identified. I used column A, but apparently that is not dorrect. YHou will need to modify the code on that line to get the correct column. The items that will need to be changed are colored red below.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$3" Then Exit Sub
fName = Range("A3").Value
On Error GoTo Hdlr:
Workbooks.Open fName & ".xlsx"
Hdlr:
    If Err.Number > 0 Then
        Err.Clear
        Set wb = Workbooks.Add
 fPath = "[URL="file://\\Ws1\MSE\CFM\"]\\Ws1\MSE\CFM\[/URL]"
        wb.SaveAs fPAth & fName & ".xlsx"
        wb.Sheets(1).Range("A3") = fName
        Set rng = Sheets("Template").Range("[COLOR=#b22222]A1[/COLOR]", Sheets("Template").Cells(Rows.Count, [COLOR=#b22222]1[/COLOR]).End(xlUp))
        Sheets("Template").rng.Copy wb.Sheets(1).Range("A4")
        MsgBox "New Workbook Created for " & wb.Name
    End If
End Sub

 

[gmkandan]

Hello JLGWhiz,

I thank you so much for the support. This solves my problem. I will correct the copy paste part of the code. I thank you for the support you have provided.

With regards,
gmkandan

this should cure the directory problem, but the tabular column is still a mystery. The ;Set rng statement is where that column would be identified. I used column A, but apparently that is not dorrect. YHou will need to modify the code on that line to get the correct column. The items that will need to be changed are colored red below.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$3" Then Exit Sub
fName = Range("A3").Value
On Error GoTo Hdlr:
Workbooks.Open fName & ".xlsx"
Hdlr:
    If Err.Number > 0 Then
        Err.Clear
        Set wb = Workbooks.Add
 fPath = "[URL="file://\\Ws1\MSE\CFM\"]\\Ws1\MSE\CFM\[/URL]"
        wb.SaveAs fPAth & fName & ".xlsx"
        wb.Sheets(1).Range("A3") = fName
        Set rng = Sheets("Template").Range("[COLOR=#b22222]A1[/COLOR]", Sheets("Template").Cells(Rows.Count, [COLOR=#b22222]1[/COLOR]).End(xlUp))
        Sheets("Template").rng.Copy wb.Sheets(1).Range("A4")
        MsgBox "New Workbook Created for " & wb.Name
    End If
End Sub

 

[JLGWhiz]

You are welcome,
Regards, JLG