Extended Columns

JoeExcelHelp
5StarLounger
Posts: 1177
Joined: 22 Jul 2013, 18:29

Extended Columns

Post by JoeExcelHelp »

Hi Hans,

You created this for me a while ago
I extended the column range in my Target WB
and modified the following line
For c2 = 7 To 58 ' G to BF
Just wondering if I should be aware of something else?

Code: Select all

Sub ScheduleData()
    Dim wbkS As Workbook ' Source workbook
    Dim wbkT As Workbook ' Target workbook
    Dim wshS As Worksheet ' Source sheet
    Dim wshT As Worksheet ' Target sheet
    Dim strSheet As String
    Dim rngFound As Range
    Dim r As Long
    Dim c As Long
    Dim m As Long
    Dim c2 As Long
    Dim strFormula As String
    Dim strType As String

    Application.ScreenUpdating = False
    ' Source workbook - modify the path as needed
    Set wbkS = Workbooks.Open(Filename:="H:\2014 SSR\Test R18\150119 SSR Macro\DataVolume.xls")
    ' Target workbook
    Set wbkT = ThisWorkbook
    ' Loop through the sheets
    For Each wshT In wbkT.Worksheets
        Select Case wshT.Name
            Case "BidDashboard", "HoursBackDashboard", "ASRDashboard", "SPTO", "Hours", "Attrition", "Actuals", "Data", "Data2", "Data3", "Data4"
                ' Skip these sheets
            Case Else
                For r = 35 To 49
                    strSheet = wshT.Cells(r, 1).Value
                    strSheet = Left(strSheet, InStr(strSheet, "_") - 1)
                    strType = wshT.Cells(r, 3).Value
                    Set wshS = wbkS.Worksheets(strSheet)
                    m = wshS.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                    Set rngFound = wshS.Range("1:1").Find(What:=strType, LookAt:=xlWhole, MatchCase:=False)
                    c = rngFound.Column
                    strFormula = "=SUMIFS([DataVolume.xls]@0!R2C@1:R@2C@1," & _
                        "[DataVolume.xls]@0!R2C2:R@2C2,R31C," & _
                        "[DataVolume.xls]@0!R2C1:R@2C1,R32C," & _
                        "[DataVolume.xls]@0!R2C3:R@2C3,R1C4," & _
                        "[DataVolume.xls]@0!R2C4:R@2C4,RC2)"
                    strFormula = Replace(strFormula, "@0", strSheet)
                    strFormula = Replace(strFormula, "@1", c)
                    strFormula = Replace(strFormula, "@2", m)
                    For c2 = 7 To 58 ' G to BF
                        With wshT.Cells(r, c2)
                            If .Value = "" Then
                                .FormulaR1C1 = strFormula
                                .Value = .Value
                            End If
                        End With
                    Next c2
                Next r
        End Select
    Next wshT
    wbkS.Close SaveChanges:=False
    Application.ScreenUpdating = True
    MsgBox "Data copied!", vbInformation
End Sub

User avatar
HansV
Administrator
Posts: 78790
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Extended Columns

Post by HansV »

Without seeing the workbook, my guess is that it should be OK.
Best wishes,
Hans

JoeExcelHelp
5StarLounger
Posts: 1177
Joined: 22 Jul 2013, 18:29

Re: Extended Columns

Post by JoeExcelHelp »

Thank You Hans