Solved: New to VBA - Help me in making this code shorter and better

Hi All

Thanks for this great Forum. I have written first code in life :) . It is for a simple activity , opening 4 files (Euro, GBP, USD, in one folder copying the active sheets in a new workbook (Consolidated) in other location. So that this new workbook has four sheets. I am sure there must be a better way to do this, like using a list box to store file name). Also I want to give name to sheets same as file names from where they are copies (to difficult for me :think:)

The code is as follows. Please help...This will help me in learning a lot.

Sub Copy_Data()

Workbooks.Open FileName:=("C:/VBA Source/Euro.xls")
Workbooks("Euro.xls").Sheets(1).Copy _
After:=Workbooks("Consolidated.xls").Sheets(1)
Workbooks("Euro.xls").Close

Workbooks.Open FileName:=("C:/VBA Source/USD.xls")
Workbooks("USD.xls").Sheets(1).Copy _
After:=Workbooks("Consolidated.xls").Sheets(1)
Workbooks("USD.xls").Close

Workbooks.Open FileName:=("C:/VBA Source/JPY.xls")
Workbooks("JPY.xls").Sheets(1).Copy _
After:=Workbooks("Consolidated.xls").Sheets(1)
Workbooks("JPY.xls").Close

Workbooks.Open FileName:=("C:/VBA Source/GBP.xls")
Workbooks("GBP.xls").Sheets(1).Copy _
After:=Workbooks("Consolidated.xls").Sheets(1)
Workbooks("GBP.xls").Close

MsgBox ("Copying worksheets completed")

End Sub

I cannot see what possible purpose trying to shorten this code or using a listbox will serve.

[vba]

Sub Copy_Data()
Dim ThisWb As Workbook
Dim wb As Workbook

Set ThisWb = Workbooks("Consolidated.xls")

Set wb = Workbooks.Open(Filename:=("C:/VBA Source/Euro.xls"))
wb.Sheets(1).Copy After:=ThisWb.Sheets(1)
ThisWb.Worksheets(2).Name = Replace(Replace(wb.Name, ".xls", ""), "C:/VBA Source/", "")
wb.Close

Workbooks.Open Filename:=("C:/VBA Source/USD.xls")
wb.Sheets(1).Copy After:=ThisWb.Sheets(1)
ThisWb.Worksheets(2).Name = Replace(Replace(wb.Name, ".xls", ""), "C:/VBA Source/", "")
wb.Close

Workbooks.Open Filename:=("C:/VBA Source/JPY.xls")
wb.Sheets(1).Copy After:=ThisWb.Sheets(1)
ThisWb.Worksheets(2).Name = Replace(Replace(wb.Name, ".xls", ""), "C:/VBA Source/", "")
wb.Close

Workbooks.Open Filename:=("C:/VBA Source/GBP.xls")
wb.Sheets(1).Copy After:=ThisWb.Sheets(1)
ThisWb.Worksheets(2).Name = Replace(Replace(wb.Name, ".xls", ""), "C:/VBA Source/", "")
wb.Close

MsgBox ("Copying worksheets completed")

End Sub
[/vba]

Hi

Thanks a lot for your reply. I am getting error on the following line. The first step is getting completed properly

[VBA]Workbooks.Open FileName:=("C:/VBA Source/USD.xls")
wb.Sheets(1).Copy After:=ThisWb.Sheets(1)
ThisWb.Worksheets(2).Name = Replace(Replace(wb.Name, ".xls", ""), "C:/VBA Source/", "")
wb.Close
[/VBA]


Regards

Works okay for me. What error do you get?

After opening the second file , i get the error on line [saying Run time error'-2147221080 (800401a8)
Automation errror]

wb.Sheets(1).Copy After:=ThisWb.Sheets(1)

Hi I did some trial and error and could solve it. Here is the code which i used. Apprantely Set Wb = was missing from the second loop. Can you tell me what does Set do?


[VBA]Sub Copy_Data()
Dim ThisWb As Workbook
Dim wb As Workbook

Set ThisWb = Workbooks("Consolidated.xls")

Set wb = Workbooks.Open(FileName:=("C:/VBA Source/Euro.xls"))
wb.Sheets(1).Copy After:=ThisWb.Sheets(1)
ThisWb.Worksheets(2).Name = Replace(Replace(wb.Name, ".xls", ""), "C:/VBA Source/", "")
wb.Close

Set wb = Workbooks.Open(FileName:=("C:/VBA Source/USD.xls"))
wb.Sheets(1).Copy After:=ThisWb.Sheets(1)
ThisWb.Worksheets(2).Name = Replace(Replace(wb.Name, ".xls", ""), "C:/VBA Source/", "")
wb.Close

Set wb = Workbooks.Open(FileName:=("C:/VBA Source/JPY.xls"))
wb.Sheets(1).Copy After:=ThisWb.Sheets(1)
ThisWb.Worksheets(2).Name = Replace(Replace(wb.Name, ".xls", ""), "C:/VBA Source/", "")
wb.Close

Set wb = Workbooks.Open(FileName:=("C:/VBA Source/GBP.xls"))
wb.Sheets(1).Copy After:=ThisWb.Sheets(1)
ThisWb.Worksheets(2).Name = Replace(Replace(wb.Name, ".xls", ""), "C:/VBA Source/", "")
wb.Close

MsgBox ("Copying worksheets completed")

End Sub[/VBA]

If I want to run above Macro in the same file again How to first delete existing sheets in the file with name USD, Euro, JPY and GBP (Or to say other way round delete all sheets except for Sheet1), so that programme runs properly.

Quote:

---

Originally Posted by vicks

Hi I did some trial and error and could solve it. Here is the code which i used. Apprantely Set Wb = was missing from the second loop. Can you tell me what does Set do?

---

It assigns an object to an object variable.

Most variables such as

myvar = 10

are really saying

Let myvar = 10

Set is used to distinguish objects from data types.

Greetings vicks,

I noticed that you just joined and your noting that this was your first efforts. Boy Howdy(!), yours sure looked better than my first attempts. Shucks, my poor computer thought there was only two modes for a while: off or BOOM!

Anyways, you asked about 'resetting' (so-to-speak) your workbook (wb) so the code could be re-run. This would be one way:

[vba]Option Explicit

Sub ThisWB_Reset()
Dim wks As Worksheet

For Each wks In ThisWorkbook.Worksheets
If Not wks.Name = "Sheet1" Then
Application.DisplayAlerts = False
wks.Delete
Application.DisplayAlerts = True
End If
Next

End Sub[/vba]

Hope that helps,

Mark

Hi GTO

Thanks for your reply and morale boosting reply. Certainly there is long way to go. :friends:

Well tell me one thing in this case I had only 4 files. If I have 20 files, can i not store the list somewhere and write the code in such a way that I can pick up name from that list? So that I dont have to write 4 lines for each file?

Vicks

Hi

Also Mark, Can you tell me how and where to put code given by you in my code? It has to be subroutine or i can put it inside? :think:

Please post entire code.

Thanks

Vicks

Hi Vicks,

Sure there is. First I need to ask a question, as I think I totally missed something, and goobered up that last answer.

What is the name of the workbook that your code is stored in? I ask because my answer assumed the code is in "Consolidated.xls" and in re-reading your and Bob's (XLD) posts, I think I was wrong.

Mark

Hi

My code is stored in Consolidated.xls and i am consolidating 4 worksheets in this file.

Vicks

Hi Mark

I could use your code in subroutine, only thing is added following addtional line in your codeOnly thing i did not use Option Explicit anywhere...I dont know how to use it

[VBA]Set ThisWb = Workbooks("Consolidated.xls")
[/VBA]

I also added additional subrouitne to delete few columns from all the sheets in Consolidated.xls.

Here is my new code which worked fine

[VBA]Sub Copy_Data()

Dim ThisWb As Workbook
Dim wb As Workbook

Set ThisWb = Workbooks("Consolidated.xls")

'to reset workbook
Call Resetting

Set wb = Workbooks.Open(FileName:=("C:/VBA Source/Euro.xls"))
wb.Sheets(1).Copy After:=ThisWb.Sheets(1)
ActiveSheet.Name = wb.Name
'ThisWb.Worksheets(2).Name = Replace(Replace(wb.Name, ".xls", ""), "C:/VBA Source/", "")
wb.Close

Set wb = Workbooks.Open(FileName:=("C:/VBA Source/USD.xls"))
wb.Sheets(1).Copy After:=ThisWb.Sheets(1)
ActiveSheet.Name = wb.Name
'ThisWb.Worksheets(2).Name = Replace(Replace(wb.Name, ".xls", ""), "C:/VBA Source/", "")
wb.Close

Set wb = Workbooks.Open(FileName:=("C:/VBA Source/JPY.xls"))
wb.Sheets(1).Copy After:=ThisWb.Sheets(1)
ActiveSheet.Name = wb.Name
'ThisWb.Worksheets(2).Name = Replace(Replace(wb.Name, ".xls", ""), "C:/VBA Source/", "")
wb.Close

Set wb = Workbooks.Open(FileName:=("C:/VBA Source/GBP.xls"))
wb.Sheets(1).Copy After:=ThisWb.Sheets(1)
ActiveSheet.Name = wb.Name
'ThisWb.Worksheets(2).Name = Replace(Replace(wb.Name, ".xls", ""), "C:/VBA Source/", "")
wb.Close

'For Deleting Colums
Call Deletecolumn

MsgBox ("Copying worksheets completed")

End Sub
Sub Resetting()
Dim wks As Worksheet
Set ThisWb = Workbooks("Consolidated.xls")

For Each wks In ThisWb.Worksheets
If Not wks.Name = "Sheet1" Then
Application.DisplayAlerts = False
wks.Delete
Application.DisplayAlerts = True
End If
Next

End Sub

Sub Deletecolumn()

ActiveWorkbook.Sheets.Select
Columns("B:AG").Select
Selection.Delete Shift:=xlToLeft
Columns("C:BF").Select
Selection.Delete Shift:=xlToLeft
'ActiveCell.FormulaR1C1 = "RECEIVE_CCY"
Columns("E:F").Select
Selection.Delete Shift:=xlToLeft
Columns("G:AC").Select
Selection.Delete Shift:=xlToLeft
Columns("H:H").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select

End Sub
[/VBA]

Do suggest changes if any

Well firstly, "Phew!", I got lucky on that one. As the code is in Consolidated, we can skip a 'Set' and just use ThisWorkbook, which always refers to the workbook it resides within.

Also - I've gotta get to work, but here's an "untested but I think okay" example. I'm sure you'll get any more questions answered, as there are some great folks here and Bob (XLD) was already helping you. He is just plain skads more knowledgeable than me; I just happened to notice your question on deleting the 'old' sheets.

Hope this helps,

Mark
[vba]Sub Copy_Data()
'// Skip this. As the code resides in Consolidated, we can just use ThisWorkbook. //
'Dim ThisWb As Workbook

Dim wb As Workbook
Dim wks As Worksheet
Dim lLastRow As Long
Dim rCell As Range

'// This will loop thru ea worksheet in ThisWorkbook (Consolidated)... //
For Each wks In ThisWorkbook.Worksheets

'// ...and if the sheet is not named (the name on the tab) "Sheet1"... //
If Not wks.Name = "Sheet1" Then

'// ...after first turning off .DisplayAlerts (so that it doesn't stop and //
'// ask us "Are you sure...?" before deleting ea sheet... //
Application.DisplayAlerts = False
'//...it then deletes the sheet... //
wks.Delete
'// ... and then turns DisplayAlerts back on, so that we don't later bash //
'// thru and do something we didn't intend to. //
Application.DisplayAlerts = True

End If

Next

'// Now, this presumes that on "Sheet1", Column A is blank, excepting for your list //
'// of workbook (wb) names that you wish to open and copy a sheet from. PLease //
'// note that there can not be other stuff farther down in Col A below your list //
'// of wb names. //

'// So, start your list of names in cell A1, then A2 and so on. Also, I left the //
'// extension in below, so it is not needed in the cell. i.e. - in cell A1, you //
'// could list "Euro", not "Euro.xls" //

lLastRow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

For Each rCell In ThisWorkbook.Worksheets("Sheet1").Range("A1:A" & lLastRow)

Set wb = Workbooks.Open(Filename:=("C:/VBA Source/" & rCell.Value & ".xls"))
wb.Sheets(1).Copy After:=ThisWorkbook.Sheets(1)
ThisWorkbook.Worksheets(2).Name = Replace(Replace(wb.Name, ".xls", ""), "C:/VBA Source/", "")
wb.Close
Next
End Sub[/vba]

Hey there,

ieexplorer crashed and you got a bit ahead on me. Read #15 in response to your #13.

Sorry 'bout the delay, I'm out for a bit,

Mark

Hey Mark,

Thanks...doesnt matter , late reply is better than no reply :yes

And boss...your code worked :yes (Although i didnt understand it fully)

I am pasting the revised code, just to be on same lines.

Can you explain me how does these two lines work and what those actually do?

[vba]lLastRow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

For Each rCell In ThisWorkbook.Worksheets("Sheet1").Range("A1:A" & lLastRow)

[/vba]
Here is the code

[VBA]Sub Copy_data()

Dim wb As Workbook
Dim wks As Worksheet
Dim lLastRow As Long
Dim rCell As Range

For Each wks In ThisWorkbook.Worksheets
If Not wks.Name = "Sheet1" Then
Application.DisplayAlerts = False
wks.Delete
Application.DisplayAlerts = True
End If
Next

lLastRow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

For Each rCell In ThisWorkbook.Worksheets("Sheet1").Range("A1:A" & lLastRow)

Set wb = Workbooks.Open(FileName:=("C:/VBA Source/" & rCell.Value & ".xls"))
wb.Sheets(1).Copy After:=ThisWorkbook.Sheets(1)
ThisWorkbook.Worksheets(2).Name = Replace(Replace(wb.Name, ".xls", ""), "C:/VBA Source/", "")
wb.Close
Next


'For Deleting Colums
Call Deletecolumn

MsgBox ("Copying worksheets completed")

End Sub
Sub Deletecolumn()

ActiveWorkbook.Sheets.Select
Columns("B:AG").Select
Selection.Delete Shift:=xlToLeft
Columns("C:BF").Select
Selection.Delete Shift:=xlToLeft
ActiveCell.FormulaR1C1 = "RECEIVE_CCY"
Columns("E:F").Select
Selection.Delete Shift:=xlToLeft
Columns("G:AC").Select
Selection.Delete Shift:=xlToLeft
Columns("H:H").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select

End Sub[/VBA]

[VBA]lLastRow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row [/VBA]

Like going to the bottom cell in Column 1 and pressing Control + Up arrow and getting the row number of the selected cell

[VBA]For Each rCell In ThisWorkbook.Worksheets("Sheet1").Range("A1:A" & lLastRow) [/VBA]

If ILastRow returned 30, this will loop through each cell from A1:A30

Delete column can be tidied up to
[VBA]Sub Deletecolumn()
ActiveWorkbook.Sheets.Select
Columns("B:AG").Delete
Columns("C:BF").Delete
Range("C1") = "RECEIVE_CCY"
Columns("E:F").Delete
Columns("G:AC").Delete
Columns("H:H").Select
Range(Columns("H:H"), Columns("H:H").End(xlToRight)).Delete
End Sub
[/VBA]
Do you really mean to run this on all sheets? see first line of code.

Hi mdmac

Thanks for your explaination and suggestion. Yes I want to perform the operation on all the sheets.

Thanks indeed. If I want to store the name of the files in the code itself rather than excel sheet, how can I do it and will it be more efficient?

Further assuming that all the files in the source folder go through this operation, is there any way out to shorten the code, knowing that i have to select all the files.

Regards

Vicks