Consulting

Results 1 to 7 of 7

Thread: VBA: Apply loop to existing code

  1. 12-15-2016, 03:36 AM #1
    RedAxon
    RedAxon is offline
    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.
    Reply With Quote Reply With Quote
  2. 12-15-2016, 05:55 AM #2
    Bob Phillips
    Bob Phillips is offline
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    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
    Reply With Quote Reply With Quote
  3. 12-15-2016, 06:24 AM #3
    RedAxon
    RedAxon is offline
    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")
    Reply With Quote Reply With Quote
  4. 12-15-2016, 06:57 AM #4
    Bob Phillips
    Bob Phillips is offline
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    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
    Reply With Quote Reply With Quote
  5. 12-15-2016, 07:02 AM #5
    Bob Phillips
    Bob Phillips is offline
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    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
    Reply With Quote Reply With Quote
  6. 12-15-2016, 07:44 AM #6
    RedAxon
    RedAxon is offline
    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?
    Reply With Quote Reply With Quote
  7. 12-15-2016, 12:21 PM #7
    Bob Phillips
    Bob Phillips is offline
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    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
    Reply With Quote Reply With Quote
« Previous Thread | Next Thread »

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
  •  

Forum Rules