Consulting

Results 1 to 7 of 7

Thread: VBA: Apply loop to existing code

  1. #1
    VBAX Newbie
    Joined
    Dec 2016
    Posts
    3
    Location

    VBA: Apply loop to existing code

    Greetings,

    I have the below code working as intended, however the amount of items I need to apply this code to has increased from a handful to several hundred. So I would like to apply a loop to the following code so that it goes through every excel document in the folder and performs the task:

    Sub InspectionSheetTransfer()
    Dim wbSource As Workbook
    Dim wbTarget As Workbook
    Dim vFile As Variant
    
    'Set source workbook
    Set wbSource = ActiveWorkbook
    
    'Open the source workbook
    vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
        1, "Select One File To Open", , False)
    
    'if the user didn't select a file, exit sub
    If TypeName(vFile) = "Boolean" Then Exit Sub
    Workbooks.Open vFile
    
    'Set selectedworkbook
    Set wbTarget = ActiveWorkbook
    
    'transfer values
        'Tag Number
        wbSource.Sheets("Sheet1").Range("A2").Value = wbTarget.Sheets("Insp. Sheet").Range("M8")
        'Location
        wbSource.Sheets("Sheet1").Range("C2").Value = wbTarget.Sheets("Insp. Sheet").Range("T8")
        
        'Equipment Description
        wbSource.Sheets("Sheet1").Range("E2").Value = wbTarget.Sheets("Insp. Sheet").Range("C10")
        
        'Manufacturer
        wbSource.Sheets("Sheet1").Range("J2").Value = wbTarget.Sheets("Insp. Sheet").Range("I10")
        
        'Model
        wbSource.Sheets("Sheet1").Range("K2").Value = wbTarget.Sheets("Insp. Sheet").Range("P10")
        
        'Serial Number
        wbSource.Sheets("Sheet1").Range("L2").Value = wbTarget.Sheets("Insp. Sheet").Range("M8")
        
        'Cable Reference
        wbSource.Sheets("Sheet1").Range("M2").Value = wbTarget.Sheets("Insp. Sheet").Range("C12")
        
        'Ex Protection
        wbSource.Sheets("Sheet1").Range("O2").Value = wbTarget.Sheets("Insp. Sheet").Range("H12")
        
        'Gas Group
        wbSource.Sheets("Sheet1").Range("P2").Value = wbTarget.Sheets("Insp. Sheet").Range("L12")
        
        'T Rating
        wbSource.Sheets("Sheet1").Range("Q2").Value = wbTarget.Sheets("Insp. Sheet").Range("O12")
        
        'IP Rating
        wbSource.Sheets("Sheet1").Range("R2").Value = wbTarget.Sheets("Insp. Sheet").Range("R12")
        
        'Cert Number
        wbSource.Sheets("Sheet1").Range("S2").Value = wbTarget.Sheets("Insp. Sheet").Range("U12")
        
        'Drawing Number
        wbSource.Sheets("Sheet1").Range("T2").Value = wbTarget.Sheets("Insp. Sheet").Range("C14")
        
        'Grid Ref
        wbSource.Sheets("Sheet1").Range("U2").Value = wbTarget.Sheets("Insp. Sheet").Range("I14")
        
        'Area Class
        wbSource.Sheets("Sheet1").Range("W2").Value = wbTarget.Sheets("Insp. Sheet").Range("L14")
        
        'Cert Auth
        wbSource.Sheets("Sheet1").Range("X2").Value = wbTarget.Sheets("Insp. Sheet").Range("O14")
        
        'Access Normal
        wbSource.Sheets("Sheet1").Range("AE2").Value = wbTarget.Sheets("Insp. Sheet").Range("I15")
        
        'Access Ladder
        wbSource.Sheets("Sheet1").Range("AF2").Value = wbTarget.Sheets("Insp. Sheet").Range("M15")
        
        'Access Scaffold
        wbSource.Sheets("Sheet1").Range("AG2").Value = wbTarget.Sheets("Insp. Sheet").Range("Q15")
        
        'Access Ropes
        wbSource.Sheets("Sheet1").Range("AH2").Value = wbTarget.Sheets("Insp. Sheet").Range("U15")
        
        'Access Overside
        wbSource.Sheets("Sheet1").Range("AI2").Value = wbTarget.Sheets("Insp. Sheet").Range("Y15")
        
        'Area Class 0
        wbSource.Sheets("Sheet1").Range("AK2").Value = wbTarget.Sheets("Insp. Sheet").Range("F17")
        
        'Area Class 1
        wbSource.Sheets("Sheet1").Range("AL2").Value = wbTarget.Sheets("Insp. Sheet").Range("F18")
        
        'Area Class 2
        wbSource.Sheets("Sheet1").Range("AM2").Value = wbTarget.Sheets("Insp. Sheet").Range("F19")
        
        'Area Class Safe
        wbSource.Sheets("Sheet1").Range("AN2").Value = wbTarget.Sheets("Insp. Sheet").Range("F20")
        
        'Ignition Risk H
        wbSource.Sheets("Sheet1").Range("AP2").Value = wbTarget.Sheets("Insp. Sheet").Range("J17")
        
        'Ignition Risk m
        wbSource.Sheets("Sheet1").Range("AQ2").Value = wbTarget.Sheets("Insp. Sheet").Range("J18")
        
        'Ignition Risk L
        wbSource.Sheets("Sheet1").Range("AR2").Value = wbTarget.Sheets("Insp. Sheet").Range("J19")
        
        'Enviroment S
        wbSource.Sheets("Sheet1").Range("AT2").Value = wbTarget.Sheets("Insp. Sheet").Range("N17")
        
        'Enviroment m
        wbSource.Sheets("Sheet1").Range("AU2").Value = wbTarget.Sheets("Insp. Sheet").Range("N18")
        
        'Enviroment b
        wbSource.Sheets("Sheet1").Range("AV2").Value = wbTarget.Sheets("Insp. Sheet").Range("N19")
        
        'corrosion h
        wbSource.Sheets("Sheet1").Range("AX2").Value = wbTarget.Sheets("Insp. Sheet").Range("R17")
        
        'corrosion m
        wbSource.Sheets("Sheet1").Range("AY2").Value = wbTarget.Sheets("Insp. Sheet").Range("R18")
        
        'corrosion l
        wbSource.Sheets("Sheet1").Range("AZ2").Value = wbTarget.Sheets("Insp. Sheet").Range("R19")
        
        'vibration h
        wbSource.Sheets("Sheet1").Range("BB2").Value = wbTarget.Sheets("Insp. Sheet").Range("V17")
        
        'vibration m
        wbSource.Sheets("Sheet1").Range("BC2").Value = wbTarget.Sheets("Insp. Sheet").Range("V18")
        
        'vibration l
        wbSource.Sheets("Sheet1").Range("BD2").Value = wbTarget.Sheets("Insp. Sheet").Range("V19")
        
        'inspection date
        wbSource.Sheets("Sheet1").Range("BF2").Value = wbTarget.Sheets("Insp. Sheet").Range("L151")
        
        'grade of inspection
        wbSource.Sheets("Sheet1").Range("BG2").Value = wbTarget.Sheets("Insp. Sheet").Range("W24")
        
        'inspected by
        wbSource.Sheets("Sheet1").Range("BJ2").Value = wbTarget.Sheets("Insp. Sheet").Range("L154")
        
       
        
    'close inspection sheet
    wbTarget.Close
    
    End Sub
    In addition to applying the loop, the ability for the macro to enter a new line above once finished would be essentially (i.e, move the just completed line down 1)

    Thank you very much for taking the time to read this, I look forward to your reply.

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,264
    Location
    This will open a number of files and copy across, but each one will overwrite the previous, so if you want something else to happen, presumably you do, you need to say what, different ranges, different sheets?

    Sub InspectionSheetTransfer()
        Dim wbSource As Workbook
        Dim wsSource As Worksheet
        Dim wbTarget As Workbook
        Dim wsTarget As Worksheet
        Dim vFile As Variant
         
         'Set source workbook
        Set wbSource = ActiveWorkbook
        Set wsSource = wbSource.Worksheets("Sheet1")
    
        With Application.FileDialog(msoFileDialogOpen)
        
            .AllowMultiSelect = True
            .Filters.Add "Excel-files", "*.xlsx", 1
            .Title = "Select One File To Open"
            
            If .Show = 0 - 1 Then
    
                'Set selectedworkbooks
                Set wbTarget = ActiveWorkbook
                Set wsTarget = wbTarget.Sheets("Insp. Sheet")
                
                'transfer values
                With wsTarget
        
                   'Tag Number
                   wsSource.Range("A2").Value = wbTarget.Range("M8")
                
                    'Location
                   wsSource.Range("C2").Value = .Range("T8")
                    
                    'Equipment Description
                   wsSource.Range("E2").Value = .Range("C10")
                    
                    'Manufacturer
                   wsSource.Range("J2").Value = .Range("I10")
                    
                    'Model
                   wsSource.Range("K2").Value = .Range("P10")
                    
                    'Serial Number
                   wsSource.Range("L2").Value = .Range("M8")
                    
                    'Cable Reference
                   wsSource.Range("M2").Value = .Range("C12")
                    
                    'Ex Protection
                   wsSource.Range("O2").Value = .Range("H12")
                    
                    'Gas Group
                   wsSource.Range("P2").Value = .Range("L12")
                    
                    'T Rating
                   wsSource.Range("Q2").Value = .Range("O12")
                    
                    'IP Rating
                   wsSource.Range("R2").Value = .Range("R12")
                    
                    'Cert Number
                   wsSource.Range("S2").Value = .Range("U12")
                    
                    'Drawing Number
                   wsSource.Range("T2").Value = .Range("C14")
                    
                    'Grid Ref
                   wsSource.Range("U2").Value = .Range("I14")
                    
                    'Area Class
                   wsSource.Range("W2").Value = .Range("L14")
                    
                    'Cert Auth
                   wsSource.Range("X2").Value = .Range("O14")
                    
                    'Access Normal
                   wsSource.Range("AE2").Value = .Range("I15")
                    
                    'Access Ladder
                   wsSource.Range("AF2").Value = .Range("M15")
                    
                    'Access Scaffold
                   wsSource.Range("AG2").Value = .Range("Q15")
                    
                    'Access Ropes
                   wsSource.Range("AH2").Value = .Range("U15")
                    
                    'Access Overside
                   wsSource.Range("AI2").Value = .Range("Y15")
                    
                    'Area Class 0
                   wsSource.Range("AK2").Value = .Range("F17")
                    
                    'Area Class 1
                   wsSource.Range("AL2").Value = .Range("F18")
                    
                    'Area Class 2
                   wsSource.Range("AM2").Value = .Range("F19")
                    
                    'Area Class Safe
                   wsSource.Range("AN2").Value = .Range("F20")
                    
                    'Ignition Risk H
                   wsSource.Range("AP2").Value = .Range("J17")
                    
                    'Ignition Risk m
                   wsSource.Range("AQ2").Value = .Range("J18")
                    
                    'Ignition Risk L
                   wsSource.Range("AR2").Value = .Range("J19")
                    
                    'Enviroment S
                   wsSource.Range("AT2").Value = .Range("N17")
                    
                    'Enviroment m
                   wsSource.Range("AU2").Value = .Range("N18")
                    
                    'Enviroment b
                   wsSource.Range("AV2").Value = .Range("N19")
                    
                    'corrosion h
                   wsSource.Range("AX2").Value = .Range("R17")
                    
                    'corrosion m
                   wsSource.Range("AY2").Value = .Range("R18")
                    
                    'corrosion l
                   wsSource.Range("AZ2").Value = .Range("R19")
                    
                    'vibration h
                   wsSource.Range("BB2").Value = .Range("V17")
                    
                    'vibration m
                   wsSource.Range("BC2").Value = .Range("V18")
                    
                    'vibration l
                   wsSource.Range("BD2").Value = .Range("V19")
                    
                    'inspection date
                   wsSource.Range("BF2").Value = .Range("L151")
                    
                    'grade of inspection
                   wsSource.Range("BG2").Value = .Range("W24")
                    
                    'inspected by
                   wsSource.Range("BJ2").Value = .Range("L154")
                End With
                
                'close inspection sheet
                wbTarget.Close
            End If
        End With
    End Sub
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    VBAX Newbie
    Joined
    Dec 2016
    Posts
    3
    Location
    Hi xld,

    That looks great, I'll be able to add a few lines to make enter a row in excel after each excel document is finished.

    Although, I'm getting a Run-time error 9: Subscript out of range on the following:

    Set wsTarget = wbTarget.Sheets("Insp. Sheet")

  4. #4
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,264
    Location
    That suggests that there is no worksheet called 'Insp. Sheet' in the target workbook.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  5. #5
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,264
    Location
    Sorry, just realised I missed an important bit

    Sub InspectionSheetTransfer()
        Dim wbSource As Workbook
        Dim wsSource As Worksheet
        Dim wbTarget As Workbook
        Dim wsTarget As Worksheet
        Dim vFile As Variant
        Dim i As Long
         
         'Set source workbook
        Set wbSource = ActiveWorkbook
        Set wsSource = wbSource.Worksheets("Sheet1")
         
        With Application.FileDialog(msoFileDialogOpen)
             
            .AllowMultiSelect = True
            .Filters.Add "Excel-files", "*.xlsx", 1
            .Title = "Select All Files To Open"
             
            If .Show = - 1 Then
                 
                
                For i = 1 To .SelectedItems.Count
                
                    'Set selectedworkbooks
                    Set wbTarget = Workbooks.Open(.SelectedItems(i))
                    Set wsTarget = wbTarget.Worksheets("Insp. Sheet")
                 
                     'transfer values
                    With wsTarget
                         
                         'Tag Number
                        wsSource.Range("A2").Value = .Range("M8")
                         
                         'Location
                        wsSource.Range("C2").Value = .Range("T8")
                         
                         'Equipment Description
                        wsSource.Range("E2").Value = .Range("C10")
                         
                         'Manufacturer
                        wsSource.Range("J2").Value = .Range("I10")
                         
                         'Model
                        wsSource.Range("K2").Value = .Range("P10")
                         
                         'Serial Number
                        wsSource.Range("L2").Value = .Range("M8")
                         
                         'Cable Reference
                        wsSource.Range("M2").Value = .Range("C12")
                         
                         'Ex Protection
                        wsSource.Range("O2").Value = .Range("H12")
                         
                         'Gas Group
                        wsSource.Range("P2").Value = .Range("L12")
                         
                         'T Rating
                        wsSource.Range("Q2").Value = .Range("O12")
                         
                         'IP Rating
                        wsSource.Range("R2").Value = .Range("R12")
                         
                         'Cert Number
                        wsSource.Range("S2").Value = .Range("U12")
                         
                         'Drawing Number
                        wsSource.Range("T2").Value = .Range("C14")
                         
                         'Grid Ref
                        wsSource.Range("U2").Value = .Range("I14")
                         
                         'Area Class
                        wsSource.Range("W2").Value = .Range("L14")
                         
                         'Cert Auth
                        wsSource.Range("X2").Value = .Range("O14")
                         
                         'Access Normal
                        wsSource.Range("AE2").Value = .Range("I15")
                         
                         'Access Ladder
                        wsSource.Range("AF2").Value = .Range("M15")
                         
                         'Access Scaffold
                        wsSource.Range("AG2").Value = .Range("Q15")
                         
                         'Access Ropes
                        wsSource.Range("AH2").Value = .Range("U15")
                         
                         'Access Overside
                        wsSource.Range("AI2").Value = .Range("Y15")
                         
                         'Area Class 0
                        wsSource.Range("AK2").Value = .Range("F17")
                         
                         'Area Class 1
                        wsSource.Range("AL2").Value = .Range("F18")
                         
                         'Area Class 2
                        wsSource.Range("AM2").Value = .Range("F19")
                         
                         'Area Class Safe
                        wsSource.Range("AN2").Value = .Range("F20")
                         
                         'Ignition Risk H
                        wsSource.Range("AP2").Value = .Range("J17")
                         
                         'Ignition Risk m
                        wsSource.Range("AQ2").Value = .Range("J18")
                         
                         'Ignition Risk L
                        wsSource.Range("AR2").Value = .Range("J19")
                         
                         'Enviroment S
                        wsSource.Range("AT2").Value = .Range("N17")
                         
                         'Enviroment m
                        wsSource.Range("AU2").Value = .Range("N18")
                         
                         'Enviroment b
                        wsSource.Range("AV2").Value = .Range("N19")
                         
                         'corrosion h
                        wsSource.Range("AX2").Value = .Range("R17")
                         
                         'corrosion m
                        wsSource.Range("AY2").Value = .Range("R18")
                         
                         'corrosion l
                        wsSource.Range("AZ2").Value = .Range("R19")
                         
                         'vibration h
                        wsSource.Range("BB2").Value = .Range("V17")
                         
                         'vibration m
                        wsSource.Range("BC2").Value = .Range("V18")
                         
                         'vibration l
                        wsSource.Range("BD2").Value = .Range("V19")
                         
                         'inspection date
                        wsSource.Range("BF2").Value = .Range("L151")
                         
                         'grade of inspection
                        wsSource.Range("BG2").Value = .Range("W24")
                         
                         'inspected by
                        wsSource.Range("BJ2").Value = .Range("L154")
                    End With
                 
                     'close inspection sheet
                    wbTarget.Close
                Next i
            End If
        End With
    End Sub
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  6. #6
    VBAX Newbie
    Joined
    Dec 2016
    Posts
    3
    Location
    Thanks again, one last thing...

    Despite all my attempts, I can't quite work out how I would go about making a new row appear in wsSource after the copy/paste action for one sheet is completed.

    I have tried using

    'select sheet1 and create new line for next copy/paste
    Sheets("Sheet1").Select
        Rows("2:2").Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    but it comes back with subscript out of range... Any suggestions?

  7. #7
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,264
    Location
    If you are going to copy/paste each file to a new area, you will need a lot more than that, you have a whole raft of fields to copy over, and you would need to index all of the target cells. Is it your wish to copy file 1 to rows 20-100 (just an example, not necessarily the actual rows), file 2 to 120-200, file 3 to 220-300, and so on?
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •