VBA Loop through multiple array of variables

D

DataShark

New Member
Joined
Dec 15, 2021
Messages
2
Office Version
  1. 2016
Platform
  1. Windows
Hi,

I apologize ahead of time if my post is confusing. I am trying my best to explain what I am attempting to accomplish.

I have a large set of data that’s listed on a specific worksheet named “Trans-Data”. On this worksheet there are columns labeled with a specific project number that contain the data, for example B1 to B14 and I have it hard-coded to copy that correct data to the correct project. I am sure there is a much better way in accomplishing this process than what I’ve written, but my VB knowledge is limited.

1st Question – Is there a way to detect all of the worksheets name in the workbook and copy the appropriate project number’s data to the associated worksheet?

So if there are “Project” worksheets named:
  • AAA-ProjectNo.###, and its associated data is on worksheet Trans-Data, cells B1 to B14 and has a column header named AAA-ProjectNo.###
  • BBB-ProjectNo.###.### and its associated data is on worksheet Trans-Data, cells C1 to C14 and has a column header named BBB-ProjectNo.###
  • CCC-ProjectNo.###.###.### and its associated data is on worksheet Trans-Data, cells D1 to D14 and has a column header named CCC-ProjectNo.###
  • Etc.
I want to copy their associated column data to each “Projects” worksheet.

2nd Question - Again, my VB knowledge is limited but is there a way to loop through each worksheet and project and run through all of the variables rather than having to hardcode everything?

Thank you in advance!


VBA Code: 
'Set Constants
Const SourceData = "Trans-Data"
Const ACTPreFix = "ACT-"
Const WIPPreFix = "WIP-"
Const LogPath = "\\some-locations\Logs\"    UNC Path
Const LogFile = "DC_log.txt"

'Set SubProject Constants
Const Sub001 = ".010.001"
Const Sub002 = ".010.002"
Const Sub003 = ".010.003"

'Set Variables
Dim FYPeriod As Variant
Dim ProjNum As Variant
Dim fileNum As Integer
Dim UserPrompt As Integer

Sub Extract_DataCopy_Proc()

fileNum = FreeFile()

Open LogPath & LogFile For Append As #fileNum

    UserPrompt = MsgBox("Are you sure you want to proceed?", vbQuestion + vbYesNo + vbDefaultButton2, "Initiate Data Copy?")

        If UserPrompt = vbYes Then

            FYPeriod = InputBox("Enter Fiscal Year", "User Prompt - Fiscal Year Input") 'Method of receiving user input for: FISCAL YR
            ProjNum = InputBox("Enter FULL Project No.", "User Prompt - Project Number Input") 'Method of receiving user input for: PROJECT NUMBER
         
                '--------------------------------------------------------------------
                'BEGINNING
                'Sub-Project .010.001
                '--------------------------------------------------------------------
                '---------------
                'ACTUALS DATA
 
                    Debug.Print "Process Initiated on: " & Now 'Append to Imediate
                        Write #fileNum, "Process Initiated on: " & Now 'Append to log file
                    Debug.Print "Project Year: " & FYPeriod
                        Write #fileNum, "Project Year: " & FYPeriod
                    Debug.Print "Actuals Data Copy Beginning..."
                        Write #fileNum, "Actuals Data Copy Beginning..."
                    Debug.Print "For worksheet: " & ACTPreFix & ProjNum & Sub001
                        Write #fileNum, "For worksheet: " & ACTPreFix & ProjNum & Sub001
                    Debug.Print ""
                        Write #fileNum, ""
                    Print #fileNum, ""
                        Write #fileNum, ""
                    Debug.Print "---------------------------------------------"
                        Write #fileNum, "---------------------------------------------"
                    Print #fileNum, "---------------------------------------------"
                        Write #fileNum, "---------------------------------------------"
    
                    'TransYTDMaterial
                    Debug.Print "Copying: TransYTDMaterial..."
                        Write #fileNum, "Copying: TransYTDMaterial..."
                    sheets(SourceData).Range("D2:D6").Copy
                    sheets(ACTPreFix & ProjNum & Sub001).Select
                    Range("Actual" & "FY" & FYPeriod & "Mat").Select
                    ActiveSheet.Paste

                    'TransYTDHrsEngr
                    Debug.Print "Copying: TransYTDHrsEngr..."
                        Write #fileNum, "Copying: TransYTDHrsEngr..."
                    sheets(SourceData).Range("D7:D10").Copy
                    sheets(ACTPreFix & ProjNum & Sub001).Select
                    Range("Actual" & "FY" & FYPeriod & "HrsEngr").Select
                    ActiveSheet.Paste
    
                    'TransYTDEngrDollars
                    Debug.Print "Copying: TransYTDEngrDollars..."
                        Write #fileNum, "Copying: TransYTDEngrDollars..."
                    sheets(SourceData).Range("D11").Copy
                    sheets(ACTPreFix & ProjNum & Sub001).Select
                    Range("FY" & FYPeriod & "Engr").Select
                    ActiveSheet.Paste
    

                    Debug.Print "---------------------------------------------"
                        Write #fileNum, "---------------------------------------------"
                    Debug.Print "Work-In-Progess Data Copy Complete"
                        Write #fileNum, "Work-In-Progess Data Copy Complete"
                    Debug.Print "For worksheet: " & ACTPreFix & ProjNum & Sub001
                        Write #fileNum, "For worksheet: " & ACTPreFix & ProjNum & Sub001
                    Debug.Print "---------------------------------------------"
                        Write #fileNum, "---------------------------------------------"
                    Debug.Print ""
                        Write #fileNum, ""
                    Debug.Print ""
                        Write #fileNum, ""
                    Debug.Print ""
                        Write #fileNum, ""
                    Debug.Print "---------------------------------------------"
                        Write #fileNum, "---------------------------------------------"
                    Debug.Print "Data Copy Complete for & ProjNum & Sub001"
                        Write #fileNum, "---------------------------------------------"
                    Debug.Print "Process Completed on: " & Now
                        Write #fileNum, "Process Completed on: " & Now
                    Debug.Print "---------------------------------------------"
                        Write #fileNum, "---------------------------------------------"
        
                '--------------------------------------------------------------------
                'Sub-Project .010.001
                'END
                '--------------------------------------------------------------------


            Close #fileNum

        Else

            MsgBox "Process Canceled"
                Close #fileNum
    
    End If
          
Application.DisplayAlerts = True
    
End Sub
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Sort by date Sort by votes
Hi and welcome to MrExcel.

You could put a sample of what you have on your "Trans-Data" sheet.
Use the XL2BB tool minisheet.

For example, I understand that you have something like this on the sheet "Trans-Data", and that you have 2 sheets (continuing with my example), with the names "AAA-ProjectNo.001" and "BBB-ProjectNo.001.001".
vario 15dic2021.xlsm
ABC
1AAA-ProjectNo.001BBB-ProjectNo.001.001
2B2amor
3B3C3
4B4C4
5B5C5
6B6C6
7B7
8B8
9B9
Trans-Data

So which cells do you want to copy from sheet "Trans-Data" column B. from B2 to the last data in column B?
And in which cells of the sheet "AAA-ProjectNo.001" do you want to paste it?

It is convenient that you put your examples.
_______
 
Upvote 0
Hi,

Sorry for the delayed response. I have included an example worksheet similar to what the source data sheet looks like, except the Target location columns. I included those to show where the previous cell needs to be copied to. To note, there are multiple project workbooks that have different project numbers and include similar formatting. However, column B may not always start as AAA-ProjectNo.001, it could be AAA-ProjectNo.010, etc. This goes the same for all subsequent worksheets, which vary project to project. I hope I am making sense. If I need to provide more information or a better explanation please let me know! Thank you all!!

vb_samp.xlsx
ABCDEFG
1AAA-ProjectNo.001Target LocationBBB-ProjectNo.001.001Target LocationCCC-Project.001.002.001Target Location
212345Worksheet AAA-ProjectNo.001, cell B612345Worksheet BBB-ProjectNo.001.001, cell C612345Worksheet CCC-Project.001.002.001, cell D6
312345Worksheet AAA-ProjectNo.001, cell B712345Worksheet BBB-ProjectNo.001.001, cell C712345Worksheet CCC-Project.001.002.001, cell E7
412345Worksheet AAA-ProjectNo.001, cell B812345Worksheet BBB-ProjectNo.001.001, cell C812345Worksheet CCC-Project.001.002.001, cell E8
512345Worksheet AAA-ProjectNo.001, cell B912345Worksheet BBB-ProjectNo.001.001, cell C912345Worksheet CCC-Project.001.002.001, cell E9
612345Worksheet AAA-ProjectNo.001, cell B1612345Worksheet BBB-ProjectNo.001.001, cell C1612345Worksheet CCC-Project.001.002.001, cell E16
712345Worksheet AAA-ProjectNo.001, cell B2012345Worksheet BBB-ProjectNo.001.001, cell C2012345Worksheet CCC-Project.001.002.001, cell E20
812345Worksheet AAA-ProjectNo.001, cell B2212345Worksheet BBB-ProjectNo.001.001, cell C2212345Worksheet CCC-Project.001.002.001, cell E22
912345Worksheet AAA-ProjectNo.001, cell B2312345Worksheet BBB-ProjectNo.001.001, cell C2312345Worksheet CCC-Project.001.002.001, cell E23
1012345Worksheet AAA-ProjectNo.001, cell B2412345Worksheet BBB-ProjectNo.001.001, cell C2412345Worksheet CCC-Project.001.002.001, cell E24
Trans-Data
 
Upvote 0
I did not understand your example very well.
But try the following:

VBA Code: 
Sub Extract_DataCopy_Proc_2()
  Dim sh As Worksheet
  Dim arr As Variant, cell As Variant
  Dim c As Range
  Dim i As Long
  
  Set sh = Sheets("Trans-Data")
  
  'Target Location
  arr = Array("B6", "B7", "B8", "B9", "B16", "B20", "B22", "B23", "B24")
  
  For Each c In sh.Range("B1", sh.Cells(1, Columns.Count).End(1))
    If Evaluate("ISREF('" & c.Value & "'!A1)") Then
      For i = 0 To UBound(arr)
        Sheets(c.Value).Range(arr(i)).Value = sh.Cells(i + 2, c.Column).Value
      Next
    End If
  Next
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Solved
Loop to get emails from Outlook 365 has broken, and I cant work out why !
Replies
3
Views
492
netrixuser
N
WildBurrow
  • Question
Copy/Paste data to next empty row within a range - WITHOUT shifting subsequent rows up
Replies
0
Views
101
WildBurrow
WildBurrow
P
  • Question
Pull Data from multiple workbooks and transpose data side by side
Replies
0
Views
542
pragmatic123
P
J
  • Question
VBA Help. Unable to Define WB1 and WB2
Replies
8
Views
2K
GWteB
GWteB
C
  • Solved
excel vba loop through tables and copy columns
Replies
6
Views
3K
Cothalup
C

Forum statistics

Threads
1,214,525
Messages
6,120,051
Members
448,940
Latest member
mdusw

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