formula - vba macro

[russlock]

Hi, not sure if anyone can help but i am basically trying to add a fixed percentage to an existing price (Column G) on a multitude of spreadsheets with each one representing each customer.
i did record a macro and inserted the code into a previous script that Alex amended for me from "TheSpreadsheetGuru.com"
however, the amount of rows with be different on every customer as one customer will buy more items than the other so will have more rows. when I did the macro, the customer customer had 138 rows which I can see in the below script, but anyone who has more rows does not get changed and any with less just end up with a zero.

I need the script to just find the last item in column "G" and to amend the price and move on to the next spreadsheet in the folder.

Hope all the above makes sense.

Many thanks for any help offered.

====================

Sub testIncrease()
'
' testIncrease Macro
'

'

    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                'my recorded macro code here
'
' Add 6% to ccp prices
'
'
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("G:G").Select
    Selection.NumberFormat = "General"
    Range("F1").Select
    Selection.AutoFill Destination:=Range("F1:G1"), Type:=xlFillDefault
    Range("F1:G1").Select
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]*(1+6%)"
    Range("G2").Select
    Selection.AutoFill Destination:=Range("G2:G138")
    Range("G2:G138").Select
    Columns("G:G").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("F:F").Select
    Selection.Delete Shift:=xlToLeft
   
    'end of my recorded macro code
            End With
           
                    'Save and Close Workbook
           'Saving the Workbook
ActiveWorkbook.Save
ActiveWorkbook.Close
        
        'Ensure Workbook has closed before moving on to next line of code
          DoEvents
  
        'Get next file name
            xFileName = Dir
           
        Loop
    End If
   
        'Message Box when tasks are completed
      MsgBox "Task Complete!"
  
ResetSettings:
      'Reset Macro Optimization Settings
        Application.EnableEvents = True
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
End Sub

 

[Micron]

Try this on a COPY of your folder. Note: comments beginning with ''' are code lines that were either of no use (such as selecting a range, doing nothing, selecting another range) or raised runtime errors for me. You should delete them when finished looking at them. Comments beginning with '' are mine; single ' are yours.
First, make sure I understand - that the number of rows that need to populate in G is based on the number of values in column F. That is decided here
.Cells(Rows.count, "F").End(xlUp).Row)

Sub testIncrease()
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String

Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
     xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
     xFileName = Dir(xFdItem & "*.xls*")
     Do While xFileName <> ""
          Workbooks.Open (xFdItem & xFileName)
               'my recorded macro code here
               ' Add 6% to ccp prices
               With Sheets("Sheet1")
                    .Activate
                    .Columns("G:G").Select
                    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
                    '''Columns("G:G").Select
                    Selection.NumberFormat = "General"
                    '''.Range("F1").select
                    .Range("F1").AutoFill Destination:=.Range("F1:G1"), Type:=xlFillDefault
                    '''Selection.AutoFill Destination:=Range("F1:G1"), Type:=xlFillDefault
                    '''.Range("F1:G1").Select
                    .Range("G2").Select
                    ActiveCell.FormulaR1C1 = "=RC[-1]*(1+6%)"
                    '''.Range("G2").Select
                    '''Selection.AutoFill Destination:=Range("G2:G138")
                   .Range("G2").AutoFill Destination:=.Range("G2:G" & .Cells(Rows.count, "F").End(xlUp).Row)
                    '''Range("G2").Select
                    '''Range("G2:G138").Select
                    .Columns("G:G").Select
                    Selection.Copy
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    Application.CutCopyMode = False
                    .Columns("F:F").Select
                    Selection.Delete Shift:=xlToLeft
                    'end of my recorded macro code
               End With
             
          'Save and Close Workbook
          ActiveWorkbook.Save
          ActiveWorkbook.Close
          
          'Ensure Workbook has closed before moving on to next line of code
          DoEvents
          'Get next file name
          xFileName = Dir
        Loop
        MsgBox "Task Complete!" ''moved because if user cancels dialog, this message would still present.
End If

ResetSettings: ''these were never disabled in this code but I left them in
     'Reset Macro Optimization Settings
     Application.EnableEvents = True
     Application.Calculation = xlCalculationAutomatic
     Application.ScreenUpdating = True
     Set xFd = Nothing ''best practice is to destroy object variables
    
End Sub

 

[russlock]

Try this on a COPY of your folder. Note: comments beginning with ''' are code lines that were either of no use (such as selecting a range, doing nothing, selecting another range) or raised runtime errors for me. You should delete them when finished looking at them. Comments beginning with '' are mine; single ' are yours.
First, make sure I understand - that the number of rows that need to populate in G is based on the number of values in column F. That is decided here
.Cells(Rows.count, "F").End(xlUp).Row)

Sub testIncrease()
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String

Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
     xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
     xFileName = Dir(xFdItem & "*.xls*")
     Do While xFileName <> ""
          Workbooks.Open (xFdItem & xFileName)
               'my recorded macro code here
               ' Add 6% to ccp prices
               With Sheets("Sheet1")
                    .Activate
                    .Columns("G:G").Select
                    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
                    '''Columns("G:G").Select
                    Selection.NumberFormat = "General"
                    '''.Range("F1").select
                    .Range("F1").AutoFill Destination:=.Range("F1:G1"), Type:=xlFillDefault
                    '''Selection.AutoFill Destination:=Range("F1:G1"), Type:=xlFillDefault
                    '''.Range("F1:G1").Select
                    .Range("G2").Select
                    ActiveCell.FormulaR1C1 = "=RC[-1]*(1+6%)"
                    '''.Range("G2").Select
                    '''Selection.AutoFill Destination:=Range("G2:G138")
                   .Range("G2").AutoFill Destination:=.Range("G2:G" & .Cells(Rows.count, "F").End(xlUp).Row)
                    '''Range("G2").Select
                    '''Range("G2:G138").Select
                    .Columns("G:G").Select
                    Selection.Copy
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    Application.CutCopyMode = False
                    .Columns("F:F").Select
                    Selection.Delete Shift:=xlToLeft
                    'end of my recorded macro code
               End With
            
          'Save and Close Workbook
          ActiveWorkbook.Save
          ActiveWorkbook.Close
         
          'Ensure Workbook has closed before moving on to next line of code
          DoEvents
          'Get next file name
          xFileName = Dir
        Loop
        MsgBox "Task Complete!" ''moved because if user cancels dialog, this message would still present.
End If

ResetSettings: ''these were never disabled in this code but I left them in
     'Reset Macro Optimization Settings
     Application.EnableEvents = True
     Application.Calculation = xlCalculationAutomatic
     Application.ScreenUpdating = True
     Set xFd = Nothing ''best practice is to destroy object variables
   
End Sub

Works absolutely perfect. Thanks ever so much. I am going to leave all the comments in there as it doesn't impact the script at all and I will be able to learn from the above in many ways. Hours of my life will be saved and if you were local to me I would be buying the beers. Genius.

 

[Micron]

Glad I was able to help. I will have one for you later!