Autofit all cells,customer sort by comany name and then insert a line break between each different company name

[ace2ace234]

Hi all,

I am new to VBA and am struggling a bit with a code, I can do each individually but when I try and add them in together I get errors.
Basically I get a different list everyday and I have to manually auto fit, custom sort by company name(Column A) and then insert a line between each different customer,I would like to create a macro to do this for me.

any help would be much appreciated,
Thanks

 

[pbornemeier]

Post the code you are using and explain where the problems are.

 

[ace2ace234]

Hi Sorry was away for a few weeks,I have my code nearly working at the moment but am stuck at the last bit,I basically want to pull information out of a file into a folder and copy it into a checklist template..this file's name will change every time and unfortunately I have the macro done so it calls for a specific file name:

Const BOMHeaderStartRow As Integer = 4
Const MinBOMDetailStartRow As Integer = 9
Const DefaultBOMDetailColCount As Integer = 17




Sub directorylisting()




Dim Coll_Docs As New Collection
Dim Search_path, Search_Filter, Search_Fullname As String
Dim DocName As String
Dim messagebox As Integer


Dim i As Long


Search_path = "C:\RSMBOMCheck\Files" ' where ?
'Search_Filter = "*.xls" ' what ?
Set Coll_Docs = Nothing


DocName = Dir(Search_path & "\")




Do Until DocName = "" ' build the collection
Coll_Docs.Add Item:=DocName
DocName = Dir
Loop





For i = Coll_Docs.Count To 1 Step -1 '
Workbooks.OpenText filename:="C:\RSMBOMCheck\CheckBomTemplate.xlsx", DataType:=xlDelimited, Comma:=True


x = 1
Search_Fullname = Search_path & "\" & Coll_Docs(i)


Application.DisplayAlerts = False

Workbooks.OpenText filename:=Search_Fullname, DataType:=xlDelimited, Comma:=True


FormatReport
bomchecks (Coll_Docs(i))


ActiveWorkbook.SaveAs "C:\RSMBOMCheck\Done\CheckSheet_" & Range("a2") & ".xlsx"
ActiveWorkbook.Close







Next
MsgBox "Done"


End Sub


Sub FormatReport()




On Error Resume Next '[A]

Dim iBOMRowCount As Integer
Dim iBOMColCount As Integer
Dim iBOMStartRow As Integer
'Dim iEngRowCount As Integer
'Dim iEngColCount As Integer
'Dim iEngStartRow As Integer
Dim iBOMHdrRowCount As Integer '[A]

iBOMRowCount = 0 '[A]
iBOMColCount = 0 '[A]
iBOMStartRow = 0 '[A]

iBOMRowCount = Sheets("Counts").Cells(1, 1).Value
iBOMColCount = Sheets("Counts").Cells(2, 1).Value '14
iBOMHdrRowCount = Sheets("Counts").Cells(1, 2).Value '[A]
'iBOMStartRow = Sheets("Counts").Cells(3, 1).Value '13 '[D]
iBOMStartRow = BOMHeaderStartRow + iBOMHdrRowCount + 1 '[A]
'iEngRowCount = Sheets("Counts").Cells(4, 1).Value '1
'iEngColCount = Sheets("Counts").Cells(5, 1).Value '3
'iEngStartRow = Sheets("Counts").Cells(6, 1).Value 'iBOMStartRow + iBOMRowCount + 5


If (iBOMStartRow < MinBOMDetailStartRow) Then iBOMStartRow = MinBOMDetailStartRow '[A]
'If # of columns in BOMDetail is not provided, use 17 (the max)
If (iBOMColCount < 1) Then iBOMColCount = DefaultBOMDetailColCount '[A]

Sheets("BOM Report").Select

With Range(Cells(BOMHeaderStartRow, 1), Cells(MinBOMDetailStartRow - 1, 3))
.UnMerge
.Borders.LineStyle = xlNone
.Font.FontStyle = xlNormal
.Font.Bold = False
.Font.Name = "Arial"
.Font.Size = 8
.Font.ColorIndex = xlColorIndexAutomatic
End With

With Range(Cells(MinBOMDetailStartRow, 1), Cells(200, 25))
.UnMerge
.Borders.LineStyle = xlNone
.Font.FontStyle = xlNormal
.Font.Bold = False
.Font.Name = "Arial"
.Font.Size = 8
.Font.ColorIndex = xlColorIndexAutomatic
End With

Call SetupHeaderFormatting(iBOMHdrRowCount)

'Setup BOM Detail Formatting
Range(Cells(iBOMStartRow, 1), Cells(iBOMStartRow + iBOMRowCount, iBOMColCount)).Select

With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Range(Cells(iBOMStartRow, 1), Cells(iBOMStartRow, iBOMColCount)).Select
Selection.Font.Bold = True
Selection.EntireRow.AutoFit


'Bug 1412 Fix - BEGIN {
If (iBOMRowCount > 0) Then
Range(Cells(iBOMStartRow + 1, 1), Cells(iBOMStartRow + iBOMRowCount, iBOMColCount)).Select
Selection.Font.Bold = False
Selection.Rows.AutoFit
End If
'Bug 1412 Fix - END }

' EngSpec - Comment out 07/05/00 - waiting for BE provide Generic Eng data
'Range(Cells(iEngStartRow, 1), Cells(iEngStartRow + iEngRowCount, iEngColCount)).Select
'With Selection.Borders(xlEdgeLeft)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
'End With
'With Selection.Borders(xlEdgeLeft)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
'End With
'With Selection.Borders(xlEdgeTop)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
'End With
'With Selection.Borders(xlEdgeBottom)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
'End With
'With Selection.Borders(xlEdgeRight)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
'End With
'With Selection.Borders(xlInsideVertical)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
'End With
'With Selection.Borders(xlInsideHorizontal)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
'End With
'With Selection.Font
' .Name = "Arial"
' .FontStyle = "Regular"
' .Size = 8
' .Strikethrough = False
' .Superscript = False
' .Subscript = False
' .OutlineFont = False
' .Shadow = False
' .Underline = xlUnderlineStyleNone
' .ColorIndex = xlAutomatic
'End With
'With Selection
' .HorizontalAlignment = xlGeneral
' .VerticalAlignment = xlBottom
' .WrapText = True
' .Orientation = 0
' .AddIndent = False
' .ShrinkToFit = False
' .MergeCells = False
'End With
'Range(Cells(iEngStartRow, 1), Cells(iEngStartRow, iEngColCount)).Select
'Selection.Font.Bold = True
Range(Cells(1, 1), Cells(1, 1)).Select


End Sub


'*********************************************************************
'* Name: SetupHeaderFormatting
'* Purpose: Setup the merging, borders and font of cells which display
'* the BOM Header information
'*
'* Parameters:
'* iRowCount Integer # of rows used for displaying the BOM Header
'*
'* Returns: Nothing
'*
'* Logic/PseudoCode:
'* Create a Range going from Row#4.Col1 to Row #4+iRowCount-1.Col#3
'* Set the font properties of this range (Arial, 8Pt, Normal, AutoColor)
'* For iRowCount # of Rows starting at Row #4
'* Make a range of the first 2 cells in the row
'* Merge the range
'* Setup borders around it (thin, continuous)
'* Make its font Bold
'*
'* Setup Borders around Cell#3 in iRow (col #3)
'* End For
'*
'* Change History:
'* 02/21/03 v-vikask Initial Version
'*********************************************************************
Private Sub SetupHeaderFormatting(iRowCount As Integer)
On Error GoTo ErrHandler
Dim iStartRow As Integer
Dim iRow As Integer
Dim sh As Worksheet
Dim rRange As Range

iStartRow = BOMHeaderStartRow

Set sh = ActiveSheet

If (iRowCount = 0) Then Exit Sub

Set rRange = sh.Range(sh.Cells(iStartRow, 1), sh.Cells(iStartRow + iRowCount - 1, 3))
With rRange.Font
.FontStyle = xlNormal
.Bold = False
.Name = "Arial"
.Size = 8
.ColorIndex = xlColorIndexAutomatic
End With

For iRow = iStartRow To iStartRow + iRowCount - 1 Step 1
Set rRange = sh.Range(sh.Cells(iRow, 1), sh.Cells(iRow, 2))
With rRange
.Merge
Call .BorderAround(xlContinuous, xlThin, xlColorIndexAutomatic)
.Font.Bold = True
End With

With sh.Cells(iRow, 3)
Call .BorderAround(xlContinuous, xlThin, xlColorIndexAutomatic)
End With
Next iRow

Set rRange = sh.Range(sh.Cells(iStartRow, 1), sh.Cells(iStartRow + iRowCount - 1, 3))
rRange.EntireRow.AutoFit

Exit Sub

ErrHandler:
Exit Sub 'Ignore Errors
End Sub


Sub bomchecks(filename)
'
' bomchecks Macro
'


'

Rows("25:25").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C15").Select
Selection.Copy
Range("B25").Select
ActiveSheet.Paste
Range("A15:B15").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "UPC"
Range("C25").Select
ActiveCell.FormulaR1C1 = "UPC"
Rows("1:22").Select
Selection.Delete Shift:=xlUp
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("A:A").Select
Selection.Cut
Windows("CheckBomTemplate.xlsx").Activate
Columns("A:A").Select
ActiveSheet.Paste
Windows("3pt-00018-Oct 6 2014 05.09.27.XLS").Activate
Columns("B:B").Select
Selection.Cut
Windows("CheckBomTemplate.xlsx").Activate
Columns("B:B").Select
ActiveSheet.Paste
Windows("3pt-00018-Oct 6 2014 05.09.27.XLS").Activate
Columns("G:G").Select
Selection.Cut
Windows("CheckBomTemplate.xlsx").Activate
Columns("D:D").Select
ActiveSheet.Paste

End Sub


I believe the problem is the part i have underlined.This file name will be different everytime i download a file to this folder,.

can someone help here,

much appreciated

 

[pbornemeier]

Is the filename in Sub bomchecks(filename) the same file as "3pt-00018-Oct 6 2014 05.09.27.XLS"?
If not, how should the underlined file (which changes) be identified?

I modified a bit of each procedure. General rule of thumb is to select as little as possible, the code will run faster.

Is there only 1 worksheet in "CheckBomTemplate.xlsx"?

Before the first line executes in Sub bomchecks you should have a check in an expected value (in Row 25?) in to ensure that bomcheck has not already been run against the file.

Use code tags (see link in my sig) to post your code - that will preserve indents.

Option Explicit

'http://www.mrexcel.com/forum/excel-questions/808685-autofit-all-cells-customer-sort-comany-name-then-insert-line-break-between-each-different-company-name.html

Const BOMHeaderStartRow As Integer = 4
Const MinBOMDetailStartRow As Integer = 9
Const DefaultBOMDetailColCount As Integer = 17

Sub directorylisting()
    
    Dim Coll_Docs As New Collection
    Dim Search_path, Search_Filter, Search_Fullname As String
    Dim DocName As String
    Dim messagebox As Integer
    Dim i As Long
    Dim lX As Long  'new
    
    Search_path = "C:\RSMBOMCheck\Files" ' where ?
    'Search_Filter = "*.xls" ' what ?
    Set Coll_Docs = Nothing
    
    DocName = Dir(Search_path & "\")
    
    Do Until DocName = "" ' build the collection
        Coll_Docs.Add Item:=DocName
        DocName = Dir
    Loop
    
    For i = Coll_Docs.Count To 1 Step -1 '
    
        Workbooks.OpenText filename:="C:\RSMBOMCheck\CheckBomTemplate.xlsx", DataType:=xlDelimited, Comma:=True
        
        x = 1
        Search_Fullname = Search_path & "\" & Coll_Docs(i)
        
        Application.DisplayAlerts = False
        
        Workbooks.OpenText filename:=Search_Fullname, DataType:=xlDelimited, Comma:=True
        
        FormatReport
        bomchecks (Coll_Docs(i))
        
        ActiveWorkbook.SaveAs "C:\RSMBOMCheck\Done\CheckSheet_" & Range("a2") & ".xlsx"
        ActiveWorkbook.Close
    
    Next
    MsgBox "Done"
    
End Sub
    
Sub FormatReport()
    
    On Error Resume Next '[A]  'Should be limited to lines causing error, then
                               'work at getting rid of error
    Dim iBOMRowCount As Integer
    Dim iBOMColCount As Integer
    Dim iBOMStartRow As Integer
    'Dim iEngRowCount As Integer
    'Dim iEngColCount As Integer
    'Dim iEngStartRow As Integer
    Dim iBOMHdrRowCount As Integer '[A]
    
    iBOMRowCount = 0 '[A]
    iBOMColCount = 0 '[A]
    iBOMStartRow = 0 '[A]
    
    iBOMRowCount = Sheets("Counts").Cells(1, 1).Value
    iBOMColCount = Sheets("Counts").Cells(2, 1).Value '14
    iBOMHdrRowCount = Sheets("Counts").Cells(1, 2).Value '[A]
    'iBOMStartRow = Sheets("Counts").Cells(3, 1).Value '13 '[D]
    iBOMStartRow = BOMHeaderStartRow + iBOMHdrRowCount + 1 '[A]
    'iEngRowCount = Sheets("Counts").Cells(4, 1).Value '1
    'iEngColCount = Sheets("Counts").Cells(5, 1).Value '3
    'iEngStartRow = Sheets("Counts").Cells(6, 1).Value 'iBOMStartRow + iBOMRowCount + 5
    
    If (iBOMStartRow < MinBOMDetailStartRow) Then iBOMStartRow = MinBOMDetailStartRow '[A]
    'If # of columns in BOMDetail is not provided, use 17 (the max)
    If (iBOMColCount < 1) Then iBOMColCount = DefaultBOMDetailColCount '[A]
    
    Sheets("BOM Report").Select
    
    With Range(Cells(BOMHeaderStartRow, 1), Cells(MinBOMDetailStartRow - 1, 3))
        .UnMerge
        .Borders.LineStyle = xlNone
        .Font.FontStyle = xlNormal
        .Font.Bold = False
        .Font.Name = "Arial"
        .Font.Size = 8
        .Font.ColorIndex = xlColorIndexAutomatic
    End With
    
    With Range(Cells(MinBOMDetailStartRow, 1), Cells(200, 25))
        .UnMerge
        .Borders.LineStyle = xlNone
        .Font.FontStyle = xlNormal
        .Font.Bold = False
        .Font.Name = "Arial"
        .Font.Size = 8
        .Font.ColorIndex = xlColorIndexAutomatic
    End With
    
    Call SetupHeaderFormatting(iBOMHdrRowCount)
    
    'Setup BOM Detail Formatting
'    Range(Cells(iBOMStartRow, 1), Cells(iBOMStartRow + iBOMRowCount, iBOMColCount)).Select
'
'    With Selection.Borders(xlEdgeLeft)
'    .LineStyle = xlContinuous
'    .Weight = xlThin
'    .ColorIndex = xlAutomatic
'    End With
'    With Selection.Borders(xlEdgeLeft)
'    .LineStyle = xlContinuous
'    .Weight = xlThin
'    .ColorIndex = xlAutomatic
'    End With
'    With Selection.Borders(xlEdgeTop)
'    .LineStyle = xlContinuous
'    .Weight = xlThin
'    .ColorIndex = xlAutomatic
'    End With
'    With Selection.Borders(xlEdgeBottom)
'    .LineStyle = xlContinuous
'    .Weight = xlThin
'    .ColorIndex = xlAutomatic
'    End With
'    With Selection.Borders(xlEdgeRight)
'    .LineStyle = xlContinuous
'    .Weight = xlThin
'    .ColorIndex = xlAutomatic
'    End With
'    With Selection.Borders(xlInsideVertical)
'    .LineStyle = xlContinuous
'    .Weight = xlThin
'    .ColorIndex = xlAutomatic
'    End With
'    With Selection.Borders(xlInsideHorizontal)
'    .LineStyle = xlContinuous
'    .Weight = xlThin
'    .ColorIndex = xlAutomatic
'    End With
    
    For lX = 7 To 12
        On Error Resume Next    'In case only 1 row or column selected
                                ' otherwise error on xlInsideHorizontal & xlInsideVertical
        With Range(Cells(iBOMStartRow, 1), Cells(iBOMStartRow + iBOMRowCount, iBOMColCount)).Borders(lX)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        On Error GoTo 0
    Next
    
    With Range(Cells(iBOMStartRow, 1), Cells(iBOMStartRow + iBOMRowCount, iBOMColCount))
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
        With .Font
            .Name = "Arial"
            .FontStyle = "Regular"
            .Size = 8
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
        End With
    End With
    
    With Range(Cells(iBOMStartRow, 1), Cells(iBOMStartRow, iBOMColCount))
        .Font.Bold = True
        .EntireRow.AutoFit
    End With
    
    'Bug 1412 Fix - BEGIN {
    If (iBOMRowCount > 0) Then
        With Range(Cells(iBOMStartRow + 1, 1), Cells(iBOMStartRow + iBOMRowCount, iBOMColCount))
            .Font.Bold = False
            .Rows.AutoFit
        End With
    End If
    'Bug 1412 Fix - END }
    
    ' EngSpec - Comment out 07/05/00 - waiting for BE provide Generic Eng data
    'Range(Cells(iEngStartRow, 1), Cells(iEngStartRow + iEngRowCount, iEngColCount)).Select
    'With Selection.Borders(xlEdgeLeft)
    ' .LineStyle = xlContinuous
    ' .Weight = xlThin
    ' .ColorIndex = xlAutomatic
    'End With
    'With Selection.Borders(xlEdgeLeft)
    ' .LineStyle = xlContinuous
    ' .Weight = xlThin
    ' .ColorIndex = xlAutomatic
    'End With
    'With Selection.Borders(xlEdgeTop)
    ' .LineStyle = xlContinuous
    ' .Weight = xlThin
    ' .ColorIndex = xlAutomatic
    'End With
    'With Selection.Borders(xlEdgeBottom)
    ' .LineStyle = xlContinuous
    ' .Weight = xlThin
    ' .ColorIndex = xlAutomatic
    'End With
    'With Selection.Borders(xlEdgeRight)
    ' .LineStyle = xlContinuous
    ' .Weight = xlThin
    ' .ColorIndex = xlAutomatic
    'End With
    'With Selection.Borders(xlInsideVertical)
    ' .LineStyle = xlContinuous
    ' .Weight = xlThin
    ' .ColorIndex = xlAutomatic
    'End With
    'With Selection.Borders(xlInsideHorizontal)
    ' .LineStyle = xlContinuous
    ' .Weight = xlThin
    ' .ColorIndex = xlAutomatic
    'End With
    'With Selection.Font
    ' .Name = "Arial"
    ' .FontStyle = "Regular"
    ' .Size = 8
    ' .Strikethrough = False
    ' .Superscript = False
    ' .Subscript = False
    ' .OutlineFont = False
    ' .Shadow = False
    ' .Underline = xlUnderlineStyleNone
    ' .ColorIndex = xlAutomatic
    'End With
    'With Selection
    ' .HorizontalAlignment = xlGeneral
    ' .VerticalAlignment = xlBottom
    ' .WrapText = True
    ' .Orientation = 0
    ' .AddIndent = False
    ' .ShrinkToFit = False
    ' .MergeCells = False
    'End With
    'Range(Cells(iEngStartRow, 1), Cells(iEngStartRow, iEngColCount)).Select
    'Selection.Font.Bold = True
    Range(Cells(1, 1), Cells(1, 1)).Select


End Sub


'*********************************************************************
'* Name: SetupHeaderFormatting
'* Purpose: Setup the merging, borders and font of cells which display
'* the BOM Header information
'*
'* Parameters:
'* iRowCount Integer # of rows used for displaying the BOM Header
'*
'* Returns: Nothing
'*
'* Logic/PseudoCode:
'* Create a Range going from Row#4.Col1 to Row #4+iRowCount-1.Col#3
'* Set the font properties of this range (Arial, 8Pt, Normal, AutoColor)
'* For iRowCount # of Rows starting at Row #4
'* Make a range of the first 2 cells in the row
'* Merge the range
'* Setup borders around it (thin, continuous)
'* Make its font Bold
'*
'* Setup Borders around Cell#3 in iRow (col #3)
'* End For
'*
'* Change History:
'* 02/21/03 v-vikask Initial Version
'*********************************************************************
Private Sub SetupHeaderFormatting(iRowCount As Integer)

    On Error GoTo ErrHandler
    
    Dim iStartRow As Integer
    Dim iRow As Integer
    Dim sh As Worksheet
    Dim rRange As Range
    
    iStartRow = BOMHeaderStartRow
    
    Set sh = ActiveSheet
    
    If (iRowCount = 0) Then Exit Sub
    
    Set rRange = sh.Range(sh.Cells(iStartRow, 1), sh.Cells(iStartRow + iRowCount - 1, 3))
    With rRange.Font
        .FontStyle = xlNormal
        .Bold = False
        .Name = "Arial"
        .Size = 8
        .ColorIndex = xlColorIndexAutomatic
    End With
    
    For iRow = iStartRow To iStartRow + iRowCount - 1 Step 1
        Set rRange = sh.Range(sh.Cells(iRow, 1), sh.Cells(iRow, 2))
        With rRange
            .Merge
            Call .BorderAround(xlContinuous, xlThin, xlColorIndexAutomatic)
            .Font.Bold = True
        End With
            
        With sh.Cells(iRow, 3)
            Call .BorderAround(xlContinuous, xlThin, xlColorIndexAutomatic)
        End With
    Next iRow
    
    Set rRange = sh.Range(sh.Cells(iStartRow, 1), sh.Cells(iStartRow + iRowCount - 1, 3))
    rRange.EntireRow.AutoFit
    
    Exit Sub
    
ErrHandler:
    Exit Sub 'Ignore Errors
End Sub
    
    
Sub bomchecks(filename)
    '
    ' bomchecks Macro
    '
    Rows("25:25").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("C15").Copy Destination:=Range("B25")
    Range("A15:B15").FormulaR1C1 = "UPC"
    Range("C25").FormulaR1C1 = "UPC"
    Rows("1:22").Delete Shift:=xlUp
    Columns("A:A").Delete Shift:=xlToLeft
    Columns("A:A").Cut
    Windows("CheckBomTemplate.xlsx").Activate
    Columns("A:A").Paste
    Windows("3pt-00018-Oct 6 2014 05.09.27.XLS").Activate
    Columns("B:B").Cut
    Windows("CheckBomTemplate.xlsx").Activate
    Columns("B:B").Paste
    Windows("3pt-00018-Oct 6 2014 05.09.27.XLS").Activate
    Columns("G:G").Cut
    Windows("CheckBomTemplate.xlsx").Activate
    Columns("D:D").Paste

End Sub

 

[ace2ace234]

Hi Phil,

Thank you for your response, see answers to your questions below:

The file '3pt-00018',this will be a file I download from a site and the name will change (Could be 3pt-00019,4ts-00044,it will always be an excel file.)..I was hoping for it t be identified as the first file within that folder?

In the 'checkbomtemplate' yes thee is only one sheet.

I hope this helps

Thanks

 

[pbornemeier]

Modified bomchecks to select the source file

Sub bomchecks(filename)

    '
    ' bomchecks Macro
    '
    
    Dim vFilePathName As Variant
    Dim sFileName As String
    Dim sFileNameExt As String
    Dim sFileExt As String
    Dim sFilePath As String
    Dim lNameStarts As Long
    Dim lExtensionStarts As Long
    
    'Select and open source file
    
    vFilePathName = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
        , "Select Second File", , False)  'Last Parm = True for multiselect
    If vFilePathName = False Then GoTo End_Sub
    
    lNameStarts = InStrRev(vFilePathName, "\")
    sFilePath = Left(vFilePathName, lNameStarts)
    sFileNameExt = Mid(vFilePathName, lNameStarts + 1)
    lExtensionStarts = InStrRev(sFileNameExt, ".")
    sFileName = Left(sFileNameExt, lExtensionStarts - 1)
    sFileExt = Mid(sFileNameExt, lExtensionStarts + 1)
    Workbooks.Open filename:=vFilePathName
    
    'Insert rows and copy data from just-selected file
    
    Rows("25:25").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    
    Range("C15").Copy Destination:=Range("B25")
    
    Range("A15:B15").FormulaR1C1 = "UPC"
    
    Range("C25").FormulaR1C1 = "UPC"
    
    Rows("1:22").Delete Shift:=xlUp
    
    Columns("A:A").Delete Shift:=xlToLeft
    
    Columns("A:A").Cut
    Windows("CheckBomTemplate.xlsx").Activate
    Columns("A:A").Paste
    
    Windows(sFileNameExt).Activate
    Columns("B:B").Cut
    Windows("CheckBomTemplate.xlsx").Activate
    Columns("B:B").Paste
    
    Windows(sFileNameExt).Activate
    Columns("G:G").Cut
    Windows("CheckBomTemplate.xlsx").Activate
    Columns("D:D").Paste

End_Sub:

End Sub

 

[ace2ace234]

Hi Phil,

I go it to work, thank you very much for your help.

If you don't mind me asking where did you learn about VBA and can you recommend any online courses?

Once again thank you!!
Regards

Keith