Customize Excel by VBS

It's easy to delete rows 4-7, here's the code.

objWorksheet1.Rows(4).Resize(4).Delete

Select allOpen in new window

Not sure about putting values on the sheet,  where would those values come from and where should they go?

This question is 2nd part of below Topic.

Previous Post

That requirement was to convert CSV into Excel with some color changes based on cell value.
But I have to present excel format as per above screenshot. So excel template will be same. only vbs should take those csv value and write into excel.
Header and Legend should be Fixed as screenshot.

But there can be alternate way also. If I can get some modifed vb script which can create Header like the above screenshot (i.e. merge cell, border, freeze, remove gridlines) and add legend at the bottom, then I don't need to write into existing excel everyday. All-time when vbs executes it should replace old excel (if exist) with this proper format.

Why don't you create a template file that has the header and legend set up as required but no data.

Then instead of opening an existing file you can create a new file from the template.

That new file would only have the header and legend and would be ready to be populated with data.

Yes I Can, that also I told above that I can have fixed Excel template with header and legend, but in that case my vbs should write those csv values into excel as per proper places, I don't know that is possible or not. So I asked two way.
Either vbs will create excel with template and legends or VBS will write csv values into excel.

Where does the data come from and where should it go?

there is an ETL job which will generate CSV file everyday. But we need to send Client that CSV file in Excel formal with that above template.
As ETL job cannot generate Excel as output so I have that intermediate vb script which will convert that CSV into Excel (or delete existing row from Excel and write again with daily data).
After that ETL job will send that Excel file via email.

any help would be appreciated ..!!!

Why not have code that first lets the user select the ETL generated CSV file?

It then opens the file, applies all the required formatting,  headers etc to it and then saves it as an Excel workbook.

Finally you could send the file by email.

this is an automation process, we cannot open and save it manually. ETL limitation is to create CSV only, and we have fixed EXCEL template. so need that CSV fit to that Excel format, and that batch file or vbs file we will call from ETL itself so whatever Excel finally will modified will send that via email too.

Sorry you've lost me.

How would the data from the CSV file be transferred to the template?

Also, what exactly are you automating?

Exactly I am also not sure if that is possible or not... so asked here if CSV data can be written into pre-build excel format.
Or if this cannot be done then we have think like to create the Excel format like above screenshot (including Legends, borders) by VBS only and color it as per my available script.

This is a data governance automation, and our ETL is producing that CSV data. As client required EXCEL format output so I have used above mentioned vbs for converting CSV to EXCEL, and changed color as per cell data. But we need to send that report with certain format which u can see the screenshot with legends value.

Yes data can be written into a already formatted file, but it really depends where that data is coming from.

If you had the ETL generated CSV open it could be as simple as copying and pasting from that into the pre-formatted file.

then can you help me on that??? how vbs will take that CSV and paste into pre-formatted Excel??
what changes need to be done in my existing vbs??

Hi,

pls try

srccsvfile = Wscript.Arguments(0)
tgtxlsfile = Wscript.Arguments(1)

'Create Spreadsheet
'Look for an existing Excel instance.
On Error Resume Next ' Turn on the error handling flag
Set objExcel = GetObject(, "Excel.Application")
'If not found, create a new instance.
If Err.Number = 429 Then  '> 0
  Set objExcel = CreateObject("Excel.Application")
End If

objExcel.Visible = False
objExcel.DisplayAlerts = False

'Import CSV into Spreadsheet
Set objWorkbookSrc = objExcel.Workbooks.Open(srccsvfile)
Set objWorksheetSrc = objWorkbookSrc.Worksheets(1)
Set objWorkbookTgt = objExcel.Workbooks.Open(tgtxlsfile)
Set objWorksheetTgt = objWorkbookTgr.Worksheets(1)
'Adjust width of columns
Set objRange = objWorksheetSrc.UsedRange
Set objRangeToCopy = objRange.Resize(objRange.Rows.Count - 1).ofset(1)
objWorksheetTgt.Rows(4).Resize(4).Delete
objRangeToCopy.Copy
objWorksheetTgt.Range("A4").Insert Shift:=xlDown

aList = Array("NOT ", "NO ", "NONE", "!")
For Each Item In aList
For Each c In objWorksheetTgt.UsedRange
    If InStr(1, c.Value, Item) > 0 Then
        c.Interior.ColorIndex = 6
    End If
Next
Next


'Save Spreadsheet, 51 = Excel 2007-2010
objWorksheetTgt.Save (True)

'Release Lock on Spreadsheet
objExcel.Quit()
Set objWorksheetSrc = Nothing
Set objWorkbookSrc = Nothing
Set objWorksheetTgt = Nothing
Set objWorkbookTgt = Nothing
Set objExcel = Nothing

Select allOpen in new window

Regards

Thanks Rgonzo.... but it gives me the below error while running from CMD

D:\excel>cscript D:\excel\wrapper.vbs \\D:\excel\Sample.csv \\D:\excel\Sample_2.xlsx
Microsoft (R) Windows Script Host Version 5.8
Copyright (C) Microsoft Corporation. All rights reserved.

D:\excel\wrapper.vbs(26, 42) Microsoft VBScript compilation error: Expected statement


D:\excel>

Select allOpen in new window

then try

srccsvfile = Wscript.Arguments(0)
tgtxlsfile = Wscript.Arguments(1)

'Create Spreadsheet
'Look for an existing Excel instance.
On Error Resume Next ' Turn on the error handling flag
Set objExcel = GetObject(, "Excel.Application")
'If not found, create a new instance.
If Err.Number = 429 Then  '> 0
  Set objExcel = CreateObject("Excel.Application")
End If

objExcel.Visible = False
objExcel.DisplayAlerts = False

'Import CSV into Spreadsheet
Set objWorkbookSrc = objExcel.Workbooks.Open(srccsvfile)
Set objWorksheetSrc = objWorkbookSrc.Worksheets(1)
Set objWorkbookTgt = objExcel.Workbooks.Open(tgtxlsfile)
Set objWorksheetTgt = objWorkbookTgr.Worksheets(1)
'Adjust width of columns
Set objRange = objWorksheetSrc.UsedRange
Set objRangeToCopy = objRange.Resize(objRange.Rows.Count - 1).ofset(1)
objWorksheetTgt.Rows(4).Resize(4).Delete
objRangeToCopy.Copy
objWorksheetTgt.Range("A4").Insert Shift:=objExcel.xlDown

aList = Array("NOT ", "NO ", "NONE", "!")
For Each Item In aList
For Each c In objWorksheetTgt.UsedRange
    If InStr(1, c.Value, Item) > 0 Then
        c.Interior.ColorIndex = 6
    End If
Next
Next


'Save Spreadsheet, 51 = Excel 2007-2010
objWorksheetTgt.Save (True)

'Release Lock on Spreadsheet
objExcel.Quit()
Set objWorksheetSrc = Nothing
Set objWorkbookSrc = Nothing
Set objWorksheetTgt = Nothing
Set objWorkbookTgt = Nothing
Set objExcel = Nothing

Select allOpen in new window

how should I run this vbs??? with same argument like before?? or Preformatted excel??
and FYI same error I get again after you gave new code.

tgtxlsfile  should be the preformatted xls

but if you do not tell me where the error is I cannot help further
but first try

srccsvfile = Wscript.Arguments(0)
tgtxlsfile = Wscript.Arguments(1)

'Create Spreadsheet
'Look for an existing Excel instance.
On Error Resume Next ' Turn on the error handling flag
Set objExcel = GetObject(, "Excel.Application")
'If not found, create a new instance.
If Err.Number = 429 Then  '> 0
  Set objExcel = CreateObject("Excel.Application")
End If

objExcel.Visible = False
objExcel.DisplayAlerts = False

'Import CSV into Spreadsheet
Set objWorkbookSrc = objExcel.Workbooks.Open(srccsvfile)
Set objWorksheetSrc = objWorkbookSrc.Worksheets(1)
Set objWorkbookTgt = objExcel.Workbooks.Open(tgtxlsfile)
Set objWorksheetTgt = objWorkbookTgt.Worksheets(1)
'Adjust width of columns
Set objRange = objWorksheetSrc.UsedRange
Set objRangeToCopy = objRange.Resize(objRange.Rows.Count - 1).ofset(1)
objWorksheetTgt.Rows(4).Resize(4).Delete
objRangeToCopy.Copy
objWorksheetTgt.Range("A4").Insert Shift:=objExcel.xlDown

aList = Array("NOT ", "NO ", "NONE", "!")
For Each Item In aList
For Each c In objWorksheetTgt.UsedRange
    If InStr(1, c.Value, Item) > 0 Then
        c.Interior.ColorIndex = 6
    End If
Next
Next


'Save Spreadsheet, 51 = Excel 2007-2010
objWorksheetTgt.Save (True)

'Release Lock on Spreadsheet
objExcel.Quit()
Set objWorksheetSrc = Nothing
Set objWorkbookSrc = Nothing
Set objWorksheetTgt = Nothing
Set objWorkbookTgt = Nothing
Set objExcel = Nothing

Select allOpen in new window

Yes sir.. i have tried this... but it says only this error...


Line number 26,42 compilation error

Have you tried my latest code with the corrected line 20?

yes sir... objWorkbookTgr replaced by objWorkbookTgt

if so then try

srccsvfile = Wscript.Arguments(0)
tgtxlsfile = Wscript.Arguments(1)

'Create Spreadsheet
'Look for an existing Excel instance.
On Error Resume Next ' Turn on the error handling flag
Set objExcel = GetObject(, "Excel.Application")
'If not found, create a new instance.
If Err.Number = 429 Then  '> 0
  Set objExcel = CreateObject("Excel.Application")
End If

objExcel.Visible = False
objExcel.DisplayAlerts = False

'Import CSV into Spreadsheet
Set objWorkbookSrc = objExcel.Workbooks.Open(srccsvfile)
Set objWorksheetSrc = objWorkbookSrc.Worksheets(1)
Set objWorkbookTgt = objExcel.Workbooks.Open(tgtxlsfile)
Set objWorksheetTgt = objWorkbookTgt.Worksheets(1)
'Adjust width of columns
Set objRange = objWorksheetSrc.UsedRange
Set objRangeToCopy = objRange.Resize(objRange.Rows.Count - 1).offset(1)
objWorksheetTgt.Rows(4).Resize(4).Delete
objRangeToCopy.Copy
objWorksheetTgt.Range("A4").Insert

aList = Array("NOT ", "NO ", "NONE", "!")
For Each Item In aList
For Each c In objWorksheetTgt.UsedRange
    If InStr(1, c.Value, Item) > 0 Then
        c.Interior.ColorIndex = 6
    End If
Next
Next


'Save Spreadsheet, 51 = Excel 2007-2010
objWorksheetTgt.Save (True)

'Release Lock on Spreadsheet
objExcel.Quit()
Set objWorksheetSrc = Nothing
Set objWorkbookSrc = Nothing
Set objWorksheetTgt = Nothing
Set objWorkbookTgt = Nothing
Set objExcel = Nothing

Select allOpen in new window

No sir ... sorry to say ... This time no error came.... but exit after executing. But the Pre formatted excel has old data still remains.
After deleting and inserting Excel should be modified, but it won't. :(

Here is my pre format excel

And this is my csv

Thank you sir... its working now...

But last help probably.. after that I won't bother you...
Need borders like above

then try

srccsvfile = Wscript.Arguments(0)
tgtxlsfile = Wscript.Arguments(1)

'Create Spreadsheet
'Look for an existing Excel instance.
On Error Resume Next ' Turn on the error handling flag
Set objExcel = GetObject(, "Excel.Application")
'If not found, create a new instance.
If Err.Number = 429 Then  '> 0
  Set objExcel = CreateObject("Excel.Application")
End If

objExcel.Visible = False
objExcel.DisplayAlerts = False

'Import CSV into Spreadsheet
Set objWorkbookSrc = objExcel.Workbooks.Open(srccsvfile)
Set objWorksheetSrc = objWorkbookSrc.Worksheets(1)
Set objWorkbookTgt = objExcel.Workbooks.Open(tgtxlsfile)
Set objWorksheetTgt = objWorkbookTgr.Worksheets(1)
'Adjust width of columns
Set objRange = objWorksheetSrc.UsedRange

With objRange
    .Borders(objExcel.xlEdgeLeft).LineStyle = objExcel.xlContinuous
    .Borders(objExcel.xlEdgeTop).LineStyle = objExcel.xlContinuous
    .Borders(objExcel.xlEdgeBottom).LineStyle = objExcel.xlContinuous
    .Borders(objExcel.xlEdgeRight).LineStyle = objExcel.xlContinuous
    .Borders(objExcel.xlInsideVertical).LineStyle = objExcel.xlContinuous
    .Borders(objExcel.xlInsideHorizontal).LineStyle = objExcel.xlContinuous
End With

Set objRangeToCopy = objRange.Resize(objRange.Rows.Count - 1).ofset(1)
objWorksheetTgt.Rows(4).Resize(4).Delete
objRangeToCopy.Insert Destination:=Range("A4")

aList = Array("NOT ", "NO ", "NONE", "!")
For Each Item In aList
For Each c In objWorksheetSrc.UsedRange
    If InStr(1, c.Value, Item) > 0 Then
        c.Interior.ColorIndex = 6
    End If
Next
Next


'Save Spreadsheet, 51 = Excel 2007-2010
objWorksheetTgt.Save (True)

'Release Lock on Spreadsheet
objExcel.Quit()
Set objWorksheetSrc = Nothing
Set objWorkbookSrc = Nothing
Set objExcel = Nothing

Select allOpen in new window

here is the error ... sir.

D:\excel>cscript D:\excel\wrapper.vbs \\D:\excel\Sample.csv \\D:\excel\Sample.xlsx
Microsoft (R) Windows Script Host Version 5.8
Copyright (C) Microsoft Corporation. All rights reserved.

D:\excel\wrapper.vbs(35, 35) Microsoft VBScript compilation error: Expected statement


D:\excel>

then try

srccsvfile = Wscript.Arguments(0)
tgtxlsfile = Wscript.Arguments(1)

'Create Spreadsheet
'Look for an existing Excel instance.
On Error Resume Next ' Turn on the error handling flag
Set objExcel = GetObject(, "Excel.Application")
'If not found, create a new instance.
If Err.Number = 429 Then  '> 0
  Set objExcel = CreateObject("Excel.Application")
End If

objExcel.Visible = False
objExcel.DisplayAlerts = False

'Import CSV into Spreadsheet
Set objWorkbookSrc = objExcel.Workbooks.Open(srccsvfile)
Set objWorksheetSrc = objWorkbookSrc.Worksheets(1)
Set objWorkbookTgt = objExcel.Workbooks.Open(tgtxlsfile)
Set objWorksheetTgt = objWorkbookTgr.Worksheets(1)
'Adjust width of columns
Set objRange = objWorksheetSrc.UsedRange

With objRange
    .Borders(7).LineStyle = 1
    .Borders(8).LineStyle = 1
    .Borders(9).LineStyle = 1
    .Borders(10).LineStyle = 1
    .Borders(11).LineStyle = 1
    .Borders(12).LineStyle = 1
End With

Set objRangeToCopy = objRange.Resize(objRange.Rows.Count - 1).ofset(1)
objWorksheetTgt.Rows(4).Resize(4).Delete
objRangeToCopy.Insert Destination:=Range("A4")

aList = Array("NOT ", "NO ", "NONE", "!")
For Each Item In aList
For Each c In objWorksheetSrc.UsedRange
    If InStr(1, c.Value, Item) > 0 Then
        c.Interior.ColorIndex = 6
    End If
Next
Next


'Save Spreadsheet, 51 = Excel 2007-2010
objWorksheetTgt.Save (True)

'Release Lock on Spreadsheet
objExcel.Quit()
Set objWorksheetSrc = Nothing
Set objWorkbookSrc = Nothing
Set objExcel = Nothing

Select allOpen in new window

EDIT

srccsvfile = Wscript.Arguments(0)
tgtxlsfile = Wscript.Arguments(1)

'Create Spreadsheet
'Look for an existing Excel instance.
On Error Resume Next ' Turn on the error handling flag
Set objExcel = GetObject(, "Excel.Application")
'If not found, create a new instance.
If Err.Number = 429 Then  '> 0
  Set objExcel = CreateObject("Excel.Application")
End If

objExcel.Visible = False
objExcel.DisplayAlerts = False

'Import CSV into Spreadsheet
Set objWorkbookSrc = objExcel.Workbooks.Open(srccsvfile)
Set objWorksheetSrc = objWorkbookSrc.Worksheets(1)
Set objWorkbookTgt = objExcel.Workbooks.Open(tgtxlsfile)
Set objWorksheetTgt = objWorkbookTgr.Worksheets(1)
'Adjust width of columns
Set objRange = objWorksheetSrc.UsedRange

objRange.Borders.LineStyle = 1

Set objRangeToCopy = objRange.Resize(objRange.Rows.Count - 1).ofset(1)
objWorksheetTgt.Rows(4).Resize(4).Delete
objRangeToCopy.Insert Destination:=Range("A4")

aList = Array("NOT ", "NO ", "NONE", "!")
For Each Item In aList
For Each c In objWorksheetSrc.UsedRange
    If InStr(1, c.Value, Item) > 0 Then
        c.Interior.ColorIndex = 6
    End If
Next
Next


'Save Spreadsheet, 51 = Excel 2007-2010
objWorksheetTgt.Save (True)

'Release Lock on Spreadsheet
objExcel.Quit()
Set objWorksheetSrc = Nothing
Set objWorkbookSrc = Nothing
Set objExcel = Nothing

Select allOpen in new window

Same error with line no 28... blue arrow

Apart from that i can see 3 small defect... underline by pink...
1. Tgr might br Tgt
2. Ofset might be Offset
3.objWorksheetSrc was objWorksheetTgt before

now I have changed it agais sir.... now its working..... Tgr changed to Tgt offset to offset and Insert statement changed.... Thanks

'Import CSV into Spreadsheet
Set objWorkbookSrc = objExcel.Workbooks.Open(srccsvfile)
Set objWorksheetSrc = objWorkbookSrc.Worksheets(1)
Set objWorkbookTgt = objExcel.Workbooks.Open(tgtxlsfile)
Set objWorksheetTgt = objWorkbookTgt.Worksheets(1)
'Adjust width of columns
Set objRange = objWorksheetSrc.UsedRange
objRange.Borders.LineStyle = 1
Set objRangeToCopy = objRange.Resize(objRange.Rows.Count - 1).offset(1)
objWorksheetTgt.Rows(4).Resize(4).Delete
objRangeToCopy.Copy
objWorksheetTgt.Range("A4").Insert

Select allOpen in new window

This is perfect output as expected..... :)

Bithun

I'm glad you have a solution but it would have been nice/helpful if you had informed of the code Rgonzo71 provided you with earlier.:)

Norie, in my first post I mentioned the original code already, and second post I mentioned its a second part of Previous Post

@Rgonzo this code is behaving differently when I am adding extra row in csv. for example my csv has 10 rows now.

Name,Location,Phone,Comment1,Comment2,comment3
"ABC","Pune",123,"Expert Value","! Easy","Popular"
"XYZ","Kol",567,"! Expert value",Easy,"!Credit"
"PQR","Mum",234,"NOT value","Value for money","Debit"
"RST","DEL",0,"Value","NO value","N/A"
"Ram","KOL",100,"NO Value","value","N/A"
"XYZ","Kol",567,"! Expert value","!Easy","!Credit"
"qwer","DEL",567,"Expert value","Easy","!Credit"
"cvbn","Pune",567,"! Expert value","!Easy","!Debit"
"rtyu","DEL",567,"! Expert value","Easy","!Credit"
"kllo","Pune",567,"Expert value","NOT Easy","!Bad"

Select allOpen in new window

and I have changed code for this line ..

objWorksheetTgt.Rows(10).Resize(10).Delete

Select allOpen in new window

and see in screenshot Legends are fixed position in Row 18-19-20
but after executing the scripts this is happening

1. Legends moved to somewhere else,
2. row 1-6 repeated but right side only.

Need to adjust code like data.
and My pre-built excel has 3 worksheet, Sheet1, sheet2 and sheet3, and I want to add those records in sheet 2 only, because sheet2 has that colored header and legends available.