Shortening code to go with other VBA

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
16,820
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
Is there some way the code below can be re-written into a single piece of code so it can be added to the end of another macro.

Basically the other code opens a text file, so it opens another workbook with the text files name and this code needs to run on that workbook.

Everything I have tried so far causes the macro's below to run on the first empty workbook.

Looking for any guidance please .
Code:
Sub addFormula()
    Dim LastRow As Long
    With Sheet1
        LastRow = .UsedRange.Rows.Count
        .Range(.Cells(2, 14), .Cells(LastRow, 14)).Formula = _
        "=VLOOKUP(E2,Sheet2!A:H,8,1)"
        
    End With
End Sub

Sub addFormula3()
    Dim LastRow As Long
    With Sheet1    
        LastRow = .UsedRange.Rows.Count
        .Range(.Cells(2, 16), .Cells(LastRow, 16)).FormulaR1C1 = _
"=IF(RC[-2]>RC[-1],""OVER CAPACITY"","""")"
   
    End With
End Sub

Sub addFormula2()
    Dim LastRow As Long
    With Sheet1
        LastRow = .UsedRange.Rows.Count
        .Range(.Cells(2, 15), .Cells(LastRow, 15)).Formula = _
        "=VLOOKUP(E2,Sheet3!A:M,11,1)"
        
    End With
End Sub


Sub addFormula5()
    Dim LastRow As Long
    With Sheet1    
        LastRow = .UsedRange.Rows.Count
 .Range(.Cells(2, 17), .Cells(LastRow, 17)).FormulaR1C1 = _
    "=IF(RC[-2]<=3,""CAP NOT SET"","" "")"
    End With
End Sub
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Can't use With Sheet1 to reference the 1st sheet in another workbook. Sheet1 can only reference the 1st sheet in the same workbook where the macro is located (I think).

So, in all the macros, change With Sheet1 to With Sheets(1)

That will reference the 1st sheet in the currently active workbook when the macros are run.

In the macro that opens the text file, put this after you open the text file
addFormula
addFormula3
addFormula2
addFormula5


If that doesn't work, list the code for the macro that opens the text file.
 
Upvote 0
Thanks for your suggestion AlphaFrog. OK so far, Got part way there.

I have put With Sheets(1) in the formulas macros which has enabled the macros to be run from the new workbook and I have put a call sub in there just in case we can't get it to run from the original program.
I tried putting in the

addFormula
addFormula3
addFormula2
addFormula5

But I got an object or reference not defined error back at the first addFormula.

I have posted the code that opens the text file below to see if you have any other suggestions as I would much prefer it to run as part of the code due to the number of people who will be running the code (Some of whom hide under the bed covers at the mention of a macro)

But thanks for your help so far as at least I now have a workable solution

Code:
Sub Apply_Filter()

    Workbooks.OpenText Filename:="C:\Users\MARK22\Desktop\UserTrace.txt", Origin _
        :=xlMSDOS, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0 _
        , 1), Array(5, 1), Array(14, 1), Array(20, 1), Array(28, 1), Array(34, 1), Array(60, 1), _
        Array(65, 1), Array(72, 1), Array(78, 1), Array(84, 1), Array(92, 1), Array(102, 1), Array(110, 1)), _
        TrailingMinusNumbers:=True
        addFormula
        addFormula3
        addFormula2
        addFormula5
    Rows("1:6").Select
    Range("A6").Activate
    Selection.ClearContents
    Selection.Delete Shift:=xlUp
    Range("P8").Select
    ActiveCell.FormulaR1C1 = "To"
    Range("P9").Select
    ActiveCell.FormulaR1C1 = "Pick"
    Range("Q8").Select
    ActiveCell.FormulaR1C1 = "PickLoc"
    Range("Q9").Select
    ActiveCell.FormulaR1C1 = "<>*A???A??*"
    Range("R8").Select
    ActiveCell.FormulaR1C1 = "PickLoc"
    Range("R9").Select
    ActiveCell.FormulaR1C1 = "<>*AN5?C??*"
    Range("P16").Select
    Sheets.Add After:=Sheets(Sheets.Count)
    Range("A1").Select
    Sheets("UserTrace").Columns("A:M").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("UserTrace").Range("P8:R9"), CopyToRange:=Range("A1" _
        ), Unique:=False
    
    Sheets("UserTrace").Select
    ActiveWindow.SelectedSheets.Delete
 
 Sheets.Add After:=Sheets(Sheets.Count)
Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Sheet1").Select
Range("O2").Select
Range("R2").Select
    ActiveCell.FormulaR1C1 = "Produ"
    Range("S2").Select
    ActiveCell.FormulaR1C1 = "Produ"
    Range("R3").Select
    ActiveCell.FormulaR1C1 = ">=10000"
    Range("S3").Select
    ActiveCell.FormulaR1C1 = "<20000"
  
    Columns("A:M").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range _
        ("R2:S3"), Unique:=False
    Range("A1:M1398").Select
    Selection.EntireRow.Delete
    ActiveSheet.ShowAllData
    Range("Q2").Select
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "User"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Date"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Time"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "ID"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Code"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Desc."
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Pk"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "BinLoc"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "Act."
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "Mvd"
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "From"
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "To"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "Left"
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "Sales"
    Range("O1").Select
    ActiveCell.FormulaR1C1 = "Cap"
    Range("P1").Select
    Columns("A:O").Select
    Selection.Columns.AutoFit
    Range("P1").Select
  
    End Sub
 
Last edited:
Upvote 0
Here's your code cleaned up and the small formula macros incorporated. I made some assumption about your imported text file. It's very likely that the new macro won't work, but I gave it a shot. Perhaps you can use at least the incorporated formulas (Red).

Code:
Sub Apply_Filter()

    [COLOR="Red"]Dim LastRow As Long[/COLOR]

    Workbooks.OpenText Filename:="C:\Users\MARK22\Desktop\UserTrace.txt", Origin _
        :=xlMSDOS, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0 _
        , 1), Array(5, 1), Array(14, 1), Array(20, 1), Array(28, 1), Array(34, 1), Array(60, 1), _
        Array(65, 1), Array(72, 1), Array(78, 1), Array(84, 1), Array(92, 1), Array(102, 1), Array(110, 1)), _
        TrailingMinusNumbers:=True
        
    Application.ScreenUpdating = False
    
    [COLOR="Red"]LastRow = ActiveSheet.UsedRange.Rows.Count
    
    Range(Cells(2, 14), Cells(LastRow, 14)).Formula = _
    "=VLOOKUP(E2,Sheet2!A:H,8,1)"

    Range(Cells(2, 16), Cells(LastRow, 16)).FormulaR1C1 = _
    "=IF(RC[-2]>RC[-1],""OVER CAPACITY"","""")"

    Range(Cells(2, 15), Cells(LastRow, 15)).Formula = _
    "=VLOOKUP(E2,Sheet3!A:M,11,1)"
    
    Range(Cells(2, 17), Cells(LastRow, 17)).FormulaR1C1 = _
    "=IF(RC[-2]<=3,""CAP NOT SET"","" "")"
[/COLOR]
        
    Rows("1:6").Delete Shift:=xlUp
    Range("P8").Value = "To"
    Range("P9").Value = "Pick"
    Range("Q8").Value = "PickLoc"
    Range("Q9").Value = "<>*A???A??*"
    Range("R8").Value = "PickLoc"
    Range("R9").Value = "<>*AN5?C??*"
    Range("A1").Select
    
    Application.DisplayAlerts = False
    On Error Resume Next
        Sheets("UserTrace").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets.Add After:=Sheets(Sheets.Count)

    Sheets("Sheet1").Select
    Range("R2").Value = "Produ"
    Range("S2").Value = "Produ"
    Range("R3").Value = ">=10000"
    Range("S3").Value = "<20000"
  
    Columns("A:M").AdvancedFilter Action:=xlFilterInPlace, _
                                  CriteriaRange:=Range("R2:S3"), _
                                  Unique:=False
        
    Range("A1:M1398").EntireRow.Delete
    
    ActiveSheet.ShowAllData

    Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Value = "User"
    Range("B1").Value = "Date"
    Range("C1").Value = "Time"
    Range("D1").Value = "ID"
    Range("E1").Value = "Code"
    Range("F1").Value = "Desc."
    Range("G1").Value = "Pk"
    Range("H1").Value = "BinLoc"
    Range("I1").Value = "Act."
    Range("J1").Value = "Mvd"
    Range("K1").Value = "From"
    Range("L1").Value = "To"
    Range("M1").Value = "Left"
    Range("N1").Value = "Sales"
    Range("O1").Value = "Cap"
    Columns("A:O").Columns.AutoFit
    
    Application.ScreenUpdating = True

End Sub
 
Upvote 0
Cheers for your help AlphaFrog. I Had to put the red code in the original code as the cleaned up version wasn't working which is no great surprise as I had to do a couple of strange things like the clear contents followed by a delete because it didn't want to delete that section without it probably due to a strange character at the start when it was downloaded.
Anyway back to the main subject....
I had to put the red code further down the code because it was interfering with a vlookup but once I done that the code is working correctly.
So once again thanks for your help and when I get time I will take a look at the cleaned up version to see what I can use and what I can't
 
Upvote 0

Forum statistics

Threads
1,224,597
Messages
6,179,808
Members
452,944
Latest member
2558216095

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