VBA: Loop through a list of parameters to update spreadsheet

T

TaskMaster

Board Regular
Joined
Oct 15, 2020
Messages
75
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi Everyone hoping that you can help me with the following query.

I have managed to use the following code to open another spreadsheet, that pulls data in from our database based on the parameters in cells C2:C5, and then copy the results into my current spreadsheet and then save the file as the product code, (at the minute im manually choosing the location until I fix the spreadsheet and then i'll chose the location). Our product code is in cell C2, C3:C5 will remain fixed. What I am hoping for is to use a loop to, repeat this process for a list of product codes in column P. Is this possible and if so could anyone point me in the right direction?

Entry Template1.xlsm
ABCDEFGHIJKLMNOP
1
2Enter Code304060Product Codes
3Enter Month8304060
4Enter Year2022304061
5Enter Company1319,214.99570,977.12319,214.99570,977.12304062
6304063
7PERIODBUS_DATECREATEDCREATED_BYTYPEJNLDESCCURR_VALCURR_VALCURR_NET_VALGBP_VALGBP_VALGBP_NET_VALDESCRIPTION304064
8AUG-2231/08/202231/08/2022YKS Operations DO NO5Daily movements for 31-AUG-202212,773.1712,773.1712,773.1712,773.17122001304065
9AUG-2231/08/202231/08/2022YKS Operations DO NO5Daily movements for 31-AUG-202239,158.6739,158.6739,158.6739,158.67122003304066
10AUG-2231/08/202231/08/2022YKS Operations DO NO5Daily movements for 31-AUG-202243,436.6343,436.6343,436.6343,436.63122002304067
11AUG-2231/08/202231/08/2022YKS Operations DO NO5Daily movements for 31-AUG-202246,334.0046,334.0046,334.0046,334.00122000304068
12AUG-2231/08/202231/08/2022YKS Operations DO NO5Daily movements for 31-AUG-202247,052.5747,052.5747,052.5747,052.57121999304069
13AUG-2231/08/202231/08/2022YKS Operations DO NO5Daily movements for 31-AUG-20220.00254,031.87-254,031.87254,031.87-254,031.87121539304070
14AUG-2231/08/202231/08/2022YKS Operations DO NO5Daily movements for 31-AUG-20220.004,550.62-4,550.624,550.62-4,550.62122001304071
15AUG-2231/08/202231/08/2022YKS Operations DO NO5Daily movements for 31-AUG-20220.0012,907.65-12,907.6512,907.65-12,907.65122003304072
16AUG-2231/08/202231/08/2022YKS Operations DO NO5Daily movements for 31-AUG-20220.0014,713.11-14,713.1114,713.11-14,713.11122002304073
17AUG-2231/08/202231/08/2022YKS Operations DO NO5Daily movements for 31-AUG-20220.0016,433.73-16,433.7316,433.73-16,433.73122000304074
18AUG-2231/08/202231/08/2022YKS Operations DO NO5Daily movements for 31-AUG-20220.0016,578.01-16,578.0116,578.01-16,578.01121999304075
19AUG-2231/08/202231/08/2022YKS Operations DO NO5Daily movements for 31-AUG-2022701,437.07701,437.07701,437.07701,437.07121539304076
20304077
21304078
22304079
23304080
24304081
25304082
26304083
Summary
Cell Formulas
RangeFormula
K5:L5,H5:I5H5=SUM(H8:H999)


VBA Code: 
Sub Refresh()

Dim Trans As String
Dim Entry As String
Dim Wbk As Workbook
Dim Folder As String
Dim FileName As String

Entry = "\\Documents\Entry Template1"
Trans = "\\Documents\TRAN Template.xlsm"

   With Workbooks("Entry Template1").ActiveSheet
      Set Wbk = Workbooks.Open(Trans, ReadOnly:=True)
      Wbk.Sheets("ENQUIRY").Range("M1").Value = .Range("C4").Value
      Wbk.Sheets("ENQUIRY").Range("M2").Value = .Range("C3").Value
      Wbk.Sheets("ENQUIRY").Range("M4").Value = .Range("C5").Value
      Wbk.Sheets("ENQUIRY").Range("M5").Value = .Range("C2").Value

   End With
   
Application.Run ("'TRAN Template.xlsm'!TRANSACTION_QUERY")

   With Workbooks("Entry Template1").ActiveSheet
      LastRow = Wbk.Sheets("ENQUIRY").Cells(.Rows.Count, "J").End(xlUp).Row
      Wbk.Sheets("ENQUIRY").Range("J23:V" & LastRow).Copy
      .Range("A8").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
        Wbk.Close False
        
   End With
   
FileName = ThisWorkbook.Worksheets("Summary").Range("B2")

   With Application.FileDialog(4)
   
      .AllowMultiSelect = False
      If .Show <> -1 Then Exit Sub
      Folder = .SelectedItems(1)
      
   End With

   ActiveWorkbook.SaveAs Folder & "\" & FileName & ".xlsx", 51
   
End Sub
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Sort by date Sort by votes
I hope this gets you going in the right direction. This assumes that the list of product codes is not in an accessible worksheet somewhere. It involves keeping the listing of Product codes up-to-date using an array. If you do keep Product Codes in a worksheet you could load the array with those values.

VBA Code: 
Sub ProductCodes()

    Dim iCodesCount As Long

'   Array to hold Product Codes.
    Dim asProductCodes() As String
    
'   Set this to the number of product codes.
    iCodesCount = 3
    
    ReDim asProductCodes(iCodesCount)
    
'   Put all product codes into the array as shown.
    asProductCodes(1) = 40345
    asProductCodes(2) = 40346
    asProductCodes(3) = 40347
    
    Call ProcessCodes(asProductCodes())

End Sub


VBA Code: 
Sub ProcessCodes(asProductCodes() As String)

    Dim iCodesCount As Long
    Dim iCode As Long
    
'   Use these variables so you only have to choose directories once.
    Dim sSourceFilesPath As String
    Dim sTargetFilesPath As String
        
    Dim sProductCode As String
        
    iCodesCount = UBound(asProductCodes)
    
'   Loop Product Codes to make Product Code-specific files.
    For iCode = 1 To iCodesCount
    
        sProductCode = asProductCodes(iCode)

'Put your code to save the Product Code-specific spreadsheet here

    Next

End Sub
 
Upvote 0
Hi thank you for your reply.

I apologise if I have done this incorrectly as im not that sophisticated with using VBA. I have entered it into my workbook as follows, how do I get this to update cell C2 with the new product code before the next loop?

VBA Code: 
Sub ProductCodes()


    Dim iCodesCount As Long


'   Array to hold Product Codes.

    Dim asProductCodes() As String


'   Set this to the number of product codes.

    iCodesCount = 15


    ReDim asProductCodes(iCodesCount)


'   Put all product codes into the array as shown.

    asProductCodes(1) = 304060

    asProductCodes(2) = 304061

    asProductCodes(3) = 304062

    asProductCodes(4) = 304063

    asProductCodes(5) = 304064

    asProductCodes(6) = 304065

    asProductCodes(7) = 304066

    asProductCodes(8) = 304067

    asProductCodes(9) = 304068

    asProductCodes(10) = 304069
   

    Call ProcessCodes(asProductCodes())

 

End Sub


Sub ProcessCodes(asProductCodes() As String)

 

    Dim iCodesCount As Long

    Dim iCode As Long

   

'   Use these variables so you only have to choose directories once.

    Dim sSourceFilesPath As String

    Dim sTargetFilesPath As String

    Dim sProductCode As String

       

    iCodesCount = UBound(asProductCodes)

   

'   Loop Product Codes to make Product Code-specific files.

    For iCode = 1 To iCodesCount

   

        sProductCode = asProductCodes(iCode)

 

'Put your code to save the Product Code-specific spreadsheet here


Dim Trans As String
Dim Entry As String
Dim Wbk As Workbook
Dim FileName As String

Entry = "C:\Users\Flow\Desktop\Test"
Trans = "C:\Users\Flow\Desktop\TRAN Template.xlsm"

   With Workbooks("Test").ActiveSheet
      Set Wbk = Workbooks.Open(Trans, ReadOnly:=True)
      Wbk.Sheets("ENQUIRY").Range("M1").Value = .Range("C4").Value
      Wbk.Sheets("ENQUIRY").Range("M2").Value = .Range("C3").Value
      Wbk.Sheets("ENQUIRY").Range("M4").Value = .Range("C5").Value
      Wbk.Sheets("ENQUIRY").Range("M5").Value = .Range("C2").Value

   End With
   
Application.Run ("'TRAN Template.xlsm'!TRANSACTION_QUERY")

   With Workbooks("Test").ActiveSheet
      LastRow = Wbk.Sheets("ENQUIRY").Cells(.Rows.Count, "J").End(xlUp).Row
      Wbk.Sheets("ENQUIRY").Range("J23:V" & LastRow).Copy
      .Range("A8").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
        Wbk.Close False
        
   End With
   
FileName = "C:\Users\Flow\Desktop" & ThisWorkbook.Worksheets("Summary").Range("C2")

   ActiveWorkbook.SaveAs FileName & ".xlsm", 52

Next
 

End Sub
 
Upvote 0
I hope that this does what you want.

VBA Code: 
Sub ProcessCodes(asProductCodes() As String)

    Dim iCodesCount As Long

    Dim iCode As Long

'   Use these variables so you only have to choose directories once.

    Dim sSourceFilesPath As String

    Dim sTargetFilesPath As String

    Dim sProductCode As String
    
'   Your variables.
    Dim Trans As String

    Dim Entry As String
    
    Dim Wbk As Workbook
    
    Dim FileName As String

    iCodesCount = UBound(asProductCodes)

'   Loop Product Codes to make Product Code-specific files.

    For iCode = 1 To iCodesCount

        sProductCode = asProductCodes(iCode)

'       Your code to save the Product Code-specific spreadsheet

        Entry = "C:\Users\Flow\Desktop\Test"
        Trans = "C:\Users\Flow\Desktop\TRAN Template.xlsm"
        
        With Workbooks("Test").ActiveSheet
            
            Set Wbk = Workbooks.Open(Trans, ReadOnly:=True)
            Wbk.Sheets("ENQUIRY").Range("M1").Value = .Range("C4").Value
            Wbk.Sheets("ENQUIRY").Range("M2").Value = .Range("C3").Value
            Wbk.Sheets("ENQUIRY").Range("M4").Value = .Range("C5").Value
            Wbk.Sheets("ENQUIRY").Range("M5").Value = .Range("C2").Value
        End With
   
        Application.Run ("'TRAN Template.xlsm'!TRANSACTION_QUERY")

        With Workbooks("Test").ActiveSheet
            
'           Put the next product code into cell C2 if not the final code.
            If iCode < iCodesCount Then .Range(C2).Value = asProductCodes(iCode + 1)

            LastRow = Wbk.Sheets("ENQUIRY").Cells(.Rows.Count, "J").End(xlUp).Row
            Wbk.Sheets("ENQUIRY").Range("J23:V" & LastRow).Copy
            .Range("A8").PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            Wbk.Close False
             
        End With
   
        FileName = "C:\Users\Flow\Desktop" & ThisWorkbook.Worksheets("Summary").Range("C2")

        ActiveWorkbook.SaveAs FileName & ".xlsm", 52

    Next
 
End Sub
 
Upvote 0
The previous version did the update of C2 at the wrong point in the loop. This one does the update at the end of the loop to prepare for the next iteration.

VBA Code: 
Sub ProcessCodes(asProductCodes() As String)

    Dim iCodesCount As Long

    Dim iCode As Long

'   Use these variables so you only have to choose directories once.

    Dim sSourceFilesPath As String

    Dim sTargetFilesPath As String

    Dim sProductCode As String
    
'   Your variables.
    Dim Trans As String

    Dim Entry As String
    
    Dim Wbk As Workbook
    
    Dim FileName As String

    iCodesCount = UBound(asProductCodes)

'   Loop Product Codes to make Product Code-specific files.

    For iCode = 1 To iCodesCount

        sProductCode = asProductCodes(iCode)

'       Your code to save the Product Code-specific spreadsheet

        Entry = "C:\Users\Flow\Desktop\Test"
        Trans = "C:\Users\Flow\Desktop\TRAN Template.xlsm"
        
        With Workbooks("Test").ActiveSheet
            
            Set Wbk = Workbooks.Open(Trans, ReadOnly:=True)
            Wbk.Sheets("ENQUIRY").Range("M1").Value = .Range("C4").Value
            Wbk.Sheets("ENQUIRY").Range("M2").Value = .Range("C3").Value
            Wbk.Sheets("ENQUIRY").Range("M4").Value = .Range("C5").Value
            Wbk.Shee
ts("ENQUIRY").Range("M5").Value = .Range("C2").Value
End With

Application.Run ("'TRAN Template.xlsm'!TRANSACTION_QUERY")

With Workbooks("Test").ActiveSheet

LastRow = Wbk.Sheets("ENQUIRY").Cells(.Rows.Count, "J").End(xlUp).Row
Wbk.Sheets("ENQUIRY").Range("J23:V" & LastRow).Copy
.Range("A8").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Wbk.Close False

End With

FileName = "C:\Users\Flow\Desktop" & ThisWorkbook.Worksheets("Summary").Range("C2")

ActiveWorkbook.SaveAs FileName & ".xlsm", 52

' Put the next product code into cell C2 if not the final one.
If iCode < iCodesCount _
Then Workbooks("Test").ActiveSheet.Range(C2).Value = asProductCodes(iCode + 1)

Next

End Sub[/CODE]
 
Upvote 0
Hi Jim,

This seems to be working however falls over at this stage

VBA Code: 
Then Workbooks("Test").ActiveSheet.Range(C2).Value = asProductCodes(iCode + 1)

I am assuming because we have just saved the file to the product code name in the following section

VBA Code: 
FileName = "C:\Users\Flow\Desktop" & ThisWorkbook.Worksheets("Summary").Range("C2")

ActiveWorkbook.SaveAs FileName & ".xlsm", 52

Is there a way to reference the workbook to the filename we have just saved as?
 
Upvote 0
I'll need to know more to assist. Does the code provided process ANY product codes as expected? Is it just the last one that is not processed?

Perhaps post a link to the file so I can try to understand the issue. Providing some fake but realistic data helps too so I do not have to try to create it.
 
Upvote 0
Hi Jim,

Sorry for the delay, I have posted a link below to both the files. The file called TRAN template is linked to our database, since you'll be unable to access that I have just given you an extract of all the data in the same format as it would be spat out. This is updated in the rows shaded in red. The test file aims to open up the TRANS template file fill in the parameters and run the macro to pull the data from the DB, then copies the data back into the test workbook and then saves the file as the product code. The macro works perfectly for the first code but then doesn't loop through the remaining product codes.

Appreciate your assistance in advance.

1drv.ms

Excel

Folder
1drv.ms
 
Upvote 0
This allows you to reference the file saved using SaveAs. Note that when you do the SaveAs the workbook saved becomes the active workbook.

Sub SaveAsSetObject()

Workbooks("TestWorkbook3.xlsm").Activate

Dim wbSaved As Workbook

' After SaveAs the saved file becomes the active workbook.
ActiveWorkbook.SaveAs Filename:="C:\Users\Bob\Desktop\Mr Excel\TestWorkbook4.xlsm"

Set wbSaved = ActiveWorkbook

'this reports file name TestWorkbook4.xlsm
Debug.Print wbSaved.Name

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Solved
How to make loop stop when the cell is empty? (VBA)
Replies
3
Views
291
kvsrinivasamurthy
K
C
  • Question Question
Need to add to my search worksheet
Replies
1
Views
104
craigwojo
C
N
  • Solved
Sort emails in Outlook 365 folder, and loop through them opening the oldest first
Replies
7
Views
2K
John_w
J
R
  • Solved
Loop through Rows
Replies
4
Views
327
rollingzep
R
P
  • Question Question
VBA for sending rows of data if column A = current date. (Via email)
Replies
1
Views
732
paun_shotts
P

Forum statistics

Threads
1,223,896
Messages
6,175,260
Members
452,627
Latest member
KitkatToby

Share this page

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