Macro - Some Adjustment Needed

Vgabond

Vgabond

Board Regular
Joined
Jul 22, 2008
Messages
197
Hi ALL

I'm recorded a macro and manage to use but my challenge is that I have to keep changing the file name in order to make it run ( for different file). Below is the code and the one that highlighted in RED is the file name which I have to change everytime I run a new file. Any help is much appreciated. Thanks

:
Code: 
Sub Submit()
'
' Submit Macro
' Macro recorded 21/03/2011 by Vgabond
'

'
    Rows("1:1").Select
    Range("AA1").Activate
    Selection.Find(What:="submit", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Columns("BC:BC").Select
    Selection.TextToColumns Destination:=Range("BC1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 4), Array(2, 9), Array(3, 9)), TrailingMinusNumbers:=True
    Range("A1:CW3729").Select
    Range("AX7").Activate
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "[COLOR=Red][B]Submission_23032011[/B][/COLOR]!R1C1:R3729C101").CreatePivotTable TableDestination:="", TableName _
        :="PivotTable1", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Submit")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("TelNum"), "Count of TelNum", xlCount
    ActiveWorkbook.Save
End Sub
 
Sort by date Sort by votes
Vgabond,

Sorry about all these questions, I'm just trying to find the simplist way to do this for you.

Would there only be one file in the folder starting with "Submission_"
 
Upvote 0

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
OK Vgabond,

We'll have to go down the Browser route, try this. It's untested, as I don't have your WB or files. The browser bit works as I've tested it, and the following assumes the files you want are always in "C:\File\", and It assumes you select a valid file.

Code: 
Sub Submit()
'
' Submit Macro
' Macro recorded 21/03/2011 by Vgabond
'
'
Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    Dim vrtSelectedItem As Variant
    With fd
        If .Show = -1 Then
            For Each vrtSelectedItem In .SelectedItems
            Filename1 = Mid$(vrtSelectedItem, 9)
            Filename1 = Mid$(Filename1, 1, Len(Filename1) - 4): GoTo x
            Next vrtSelectedItem
        End If
    End With
x:
    Set fd = Nothing
    Rows("1:1").Select
    Range("AA1").Activate
    Selection.Find(What:="submit", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Columns("BC:BC").Select
    Selection.TextToColumns Destination:=Range("BC1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 4), Array(2, 9), Array(3, 9)), TrailingMinusNumbers:=True
    Range("A1:CW3729").Select
    Range("AX7").Activate
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        Filename1 & "!R1C1:R3729C101").CreatePivotTable TableDestination:="", TableName _
        :="PivotTable1", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Submit")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("TelNum"), "Count of TelNum", xlCount
    ActiveWorkbook.Save
End Sub

When you run your code now, it will start by opening a browser, if you browse to the C:\Files folder and select a valid file it should work.
 
Upvote 0
ColinKJ said:
OK Vgabond,

We'll have to go down the Browser route, try this. It's untested, as I don't have your WB or files. The browser bit works as I've tested it, and the following assumes the files you want are always in "C:\File\", and It assumes you select a valid file.

Code: 
Sub Submit()
'
' Submit Macro
' Macro recorded 21/03/2011 by Vgabond
'
'
Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    Dim vrtSelectedItem As Variant
    With fd
        If .Show = -1 Then
            For Each vrtSelectedItem In .SelectedItems
            Filename1 = Mid$(vrtSelectedItem, 9)
            Filename1 = Mid$(Filename1, 1, Len(Filename1) - 4): GoTo x
            Next vrtSelectedItem
        End If
    End With
x:
    Set fd = Nothing
    Rows("1:1").Select
    Range("AA1").Activate
    Selection.Find(What:="submit", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Columns("BC:BC").Select
    Selection.TextToColumns Destination:=Range("BC1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 4), Array(2, 9), Array(3, 9)), TrailingMinusNumbers:=True
    Range("A1:CW3729").Select
    Range("AX7").Activate
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        Filename1 & "!R1C1:R3729C101").CreatePivotTable TableDestination:="", TableName _
        :="PivotTable1", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Submit")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("TelNum"), "Count of TelNum", xlCount
    ActiveWorkbook.Save
End Sub
When you run your code now, it will start by opening a browser, if you browse to the C:\Files folder and select a valid file it should work.
Click to expand...

Hi ColinKJ

Sorry for the late reply. I was away to attend some seminar. Anyway I've test it out and there's an error :"Run Time Error 91, Object Variable or with block are not set"
 
Upvote 0
Hi Vgabond,

The bit I added runs ok this end, this is the code:

Code: 
Sub Test()
Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    Dim vrtSelectedItem As Variant
    With fd
        If .Show = -1 Then
            For Each vrtSelectedItem In .SelectedItems
            Filename1 = Mid$(vrtSelectedItem, 9)
            Filename1 = Mid$(Filename1, 1, Len(Filename1) - 4): GoTo x
            Next vrtSelectedItem
        End If
    End With
x:
End Sub

This should give you the Browser. Try putting it in a new test WB and running it.

Regards

Colin
 
Upvote 0
Hi Colin

I've added your new code and it pop up the browser to ask for a file and after you choose the file , it will gives error "Run-Time eror "91"".
Below the whole code for your view :-

Code: 
Sub Submit()
'
' Submit Macro
' Macro recorded 21/03/2011 by Vgabond
'
'
Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    Dim vrtSelectedItem As Variant
    With fd
        If .Show = -1 Then
            For Each vrtSelectedItem In .SelectedItems
            Filename1 = Mid$(vrtSelectedItem, 9)
            Filename1 = Mid$(Filename1, 1, Len(Filename1) - 4): GoTo x
            Next vrtSelectedItem
        End If
    End With
x:
    Rows("1:1").Select
    Range("AA1").Activate
    Selection.Find(What:="submit", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Columns("BC:BC").Select
    Selection.TextToColumns Destination:=Range("BC1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 4), Array(2, 9), Array(3, 9)), TrailingMinusNumbers:=True
    Range("A1:CW3729").Select
    Range("AX7").Activate
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        Filename1 & "!R1C1:R3729C101").CreatePivotTable TableDestination:="", TableName _
        :="PivotTable1", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Submit")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("TelNum"), "Count of TelNum", xlCount
    ActiveWorkbook.Save
End Sub
 
Upvote 0
Hi Vgabond,

I don't entirely understand your code after the Dialog, and I don't understand the error message, but it isn't a "With / End With" error as the code at that point isn't in With selection.

However, If you change this part of the code:

Code: 
Rows("1:1").Select
    Range("AA1").Activate
    Selection.Find(What:="submit", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate

With this:

Code: 
Rows("1:1").Select
    Range("AA1").Activate
    Columns("AA:AA").Select
   Selection.Find(What:="submit", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate

With the "submit" text anywhere in Column AA, it doesn't go to debug.

I don't know about the rest of the code, as I say, I don't entirely understand it.
 
Upvote 0
Hi Colin

No worries. Anyway thanks for the effort. I've just need to change the part for the file name instead of getting it works by calling for the file. Thanks a bunch.
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Having trouble with pivot table macro
2
Replies
12
Views
307
RoryA
RoryA
S
  • Question Question
Macro for
Replies
2
Views
120
Sanderb
S
D
  • Question Question
VBA Coding for adding Pivot Table with changing data table
Replies
6
Views
244
darmst24
D
J
  • Solved
VBA/Macro: Adding Pivot table with connection string
Replies
1
Views
252
Jette3173
J
C
  • Solved
VBA Add Pivot Table Sheet Name
Replies
1
Views
191
Anthony47
A

Forum statistics

Threads
1,224,586
Messages
6,179,719
Members
452,939
Latest member
WCrawford

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