User defined change in VBA code

M

Mebs

Board Regular
Joined
Mar 16, 2009
Messages
51
Below is some code that I have writtten which basically import 23 CSV files into one Excel file. What I need to do is to change the month 'August' to a user specified month, either select from a list Jan - Dec or get the user to type the month. When the user has selected say, January, then the code below should change to January instead of August.

Code: 
Sub Import_CSV()
ChDir _
"C:\Documents and Settings\mebs.sheikh\My Documents\Amex Approvals\August"
Workbooks.Open Filename:= _
"C:\Documents and Settings\mebs.sheikh\My Documents\Amex Approvals\August\Enfield.csv"
Sheets("Enfield").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Workbooks("Cumulative Approval 2010.xls").Worksheets("Sheet1").Activate
Range("A1").Select
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit
Windows("Enfield.csv").Activate
ActiveWindow.Close
If Range("a2") <> "" Then
Range("A2").End(xlDown).Offset(1, 0).Select
Else
Range("A2").End(xlDown).Select
End If
Workbooks.Open Filename:= _
"C:\Documents and Settings\mebs.sheikh\My Documents\Amex Approvals\August\Chertsey.csv"
'Repeat the above process 23 times with difference Office location, Enfield, Chertsey, etc
Can this be done? and what the code?

Thanks
 
Last edited by a moderator:

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Sort by date Sort by votes
Yes, it can be done. Basically, you need to grab the input from the user. You could do this with a simple inputbox in the code, or create a userform with only the desired values available, any number of things. You then just need to tweak the areas of the code where the month is displayed to call the value from the user instead.

Also, this concerns me:
Repeat the above process 23 times with difference Office location, Enfield, Chertsey, etc
Click to expand...
Do you actually have this portion of code in the sub over and over again? If yes, this could (and most likely *should*) be rewritten to perform a loop.

I'll see what code I can mock up for you in the meantime.
 
Upvote 0
Von Pookie,

Thanks for the reply and I'll look forward to the code. I don't know how to do a loop so yes, I repeat the code 23 times. The only difference is that the first time I use;

Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Which captures the row heading and
then for the next 22 times I use;
Range("A2:BA2").Select
Range(Selection, Selection.End(xlDown)).Select
because the row 1 contains the header which I will already have.

The other thing is that if I loop then how do I change the file names 'Enfield, Chertsey, etc?
 
Upvote 0
Hey there,

Sorry about the wait. I was (and still am at the moment) doing this at work and didn't get a chance to finish it on Friday.

At any rate, I haven't fully tested this as I don't have the workbooks to try it on but I think it should work.


Code: 
Sub Import_CSV()

Dim strMonth As String, chk As Boolean
Dim x As Long, arrOffice As Variant
Dim wbAmex As Workbook, wbApprv As Workbook
Dim rngCopy As Range
 
'array containing office names to go through
'add any other names to the end of the list, separated by commas
arrOffice = Array("Enfield", "Chertsey")
 
Do
    'ask user to enter month name
    strMonth = Application.InputBox("Enter the full month name (no abbreviations)", Type:=2)
    
    If strMonth = "False" Then Exit Sub 'cancel button clicked; end macro
    If strMonth = "" Then 'left entry blank
        MsgBox "You must enter a month name"
        chk = False
    Else
        'check if user entered a month abbreviation
        If Len(strMonth) = 3 And strMonth <> "May" Then
            MsgBox "Please make sure the month name is spelled correctly."
            chk = False
        Else
            'check if it was a valid month entered
            On Error Resume Next
            If Not IsNumeric(Month(strMonth & "/1/2010")) Then
                MsgBox "Please enter the full month name (no abbreviations)."
                chk = False
            Else
                'valid month was entered; continue macro
                chk = True
            End If
        End If
        On Error GoTo 0
    End If
Loop Until chk = True 'loop until user preses cancel or enters valid month
'open destination workbook
Set wbApprv = Workbooks.Open("Cumulative Approval 2010.xls")
'run code in loop for each office
For x = LBound(arrOffice) To UBound(arrOffice)
    'open workbook for desired month and office
    Set wbAmex = Workbooks.Open("C:\Documents and Settings\mebs.sheikh\My Documents\Amex Approvals\" & strMonth & "\" & arrOffice(x) & ".csv")
    
    With wbAmex
        With .Sheets(arrOffice(x))
            If arrOffice(x) = "Enfield" Then
                Set rngCopy = .Range("A1", .Range("A1").End(xlToRight)).Select
                Set rngCopy = rngCopy.End(xlDown)
                'copy and paste values to other workbook
                rngCopy.Copy Destination:=wbApprv.Sheets("Sheet1").Range("A1")
            Else
                'copy and paste values to other workbook
                .Range("A2:BA2", .Range("A2:BA2").End(xlDown)).Copy Destination:=wbApprv.Sheets("Sheet1").Range("A1")
            End If
        End With
        .Close (False) 'close workbook without saving
    End With
     
    With wbApprv.Sheets("Sheet1")
        .Cells.EntireColumn.AutoFit
        If .Range("A2") <> "" Then
            .Range("A2").End(xlDown).Offset(1, 0).Select
        Else
            .Range("A2").End(xlDown).Select
        End If
    End With
Next x 'loop to next workbook
End Sub
 
Upvote 0
Von Pookie,

No worries and I apppreciate your efforts. Pasted the code into a new workbook (just did a save as and called it v2, as I wanted to maintain the original)

The array is now;
arrOffice = Array("Aberdeen", "Central Scotland", "Tayside", "Perth", "Elgin", "North East", "North West", "North Central", "Western", "Yorkshire", "East Anglia", "Eastern", "Enfield", "Chertsey", "Thames Valley", "London Major Works", "London Special Projects", "London Specialised Works", "South", "South East", "South West")

The asking for a month works with all the logic test you have put into it.

After inputting a correctly spelt month the code does something but not sure what as it;

a) doesn't copy and Paste first workbook 'Aberdeen'
b) doesn't seem to scroll to other workbooks

Any thoughts? How do I step through the code so I can see where it falls down?

Thanks again
 
Upvote 0
Mebs said:
After inputting a correctly spelt month the code does something but not sure what as it;

a) doesn't copy and Paste first workbook 'Aberdeen'
b) doesn't seem to scroll to other workbooks

Any thoughts? How do I step through the code so I can see where it falls down?
Click to expand...

a) Not sure as to why that would be happening, especially if there are no errors displayed. You can press F8 to "step through" and run the code line by line; maybe that would shine some light on things.

b) You shouldn't necessarily be seeing it change through the workbooks. The way I reworked the code you shouldn't have to select any workbooks or cells to reference them. So where your code selected the other workbook to paste the items to, mine is simply referencing that workbook in the code. It just tends to make for nicer, speedier code without selecting things :)
 
Upvote 0
@ Von Pookie,

When I type in a month then I get data for two Offices
The code falls over at;
Set rngCopy = .Range("A1", .Range("A1").End(xlToRight)).Select
with a run time error 424 object required and at the 'Enfield' Office.
Also not convinved its pulling data from the correct month. When I tested it for June, it gave me date for Feb?

Seems the code is close, though.
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
VBA to open file, clear formats and copy paste
Replies
9
Views
281
Alex Blakenburg
A
S
  • Solved
Change export from .txt to workbook
Replies
1
Views
68
HighAndWilder
H
F
  • Question
VBA run code based off cell value
Replies
1
Views
342
igold
igold
L
  • Question
Variable Rows, Help Speeding Up
Replies
4
Views
326
kevin9999
K
D
  • Solved
Run-time error 9, Subscript out of range - Copying sheet from closed workbook to active workbook as new sheet
Replies
9
Views
307
dvward
D

Forum statistics

Threads
1,215,200
Messages
6,123,611
Members
449,109
Latest member
Sebas8956

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top