Adjust a Range

JoeExcelHelp · Post by **JoeExcelHelp** » 14 Sep 2016, 15:28

I have this code which I use daily and love it (Thanks again Hans)
This line brings in the data perfectly however, it doesn't follow the order of each range (left to right). It puts E68:BF69 after E65:BF66
Sht.Range("E65:BF66,E80:BF81,E94:BF95,E83:BF84,E96:BF97,E98:BF106,E68:BF69,E118:BF119,E132:BF133,E121:BF122,E134:BF135,E136:BF144").Copy
So I tried this but it didnt work:
Sht.Range(Range("E65:BF66,E80:BF81,E94:BF95,E83:BF84,E96:BF97,E98:BF106"),Range("E68:BF69,E118:BF119,E132:BF133,E121:BF122,E134:BF135,E136:BF144")).Copy

Code: Select all

Sub CombineAllData4()
    Dim shM As Worksheet
    Dim Sht As Worksheet
    Dim r As Long
    Application.ScreenUpdating = False
    Set shM = Worksheets("Data4")
    ' Clear the Data sheet
    shM.Range("2:" & shM.Rows.Count).ClearContents

    For Each Sht In ActiveWorkbook.Worksheets
        Select Case Sht.Name
            Case "Schedule", "Hours", "Attrition", "Orientation", "Actuals", "ClassDist", "Data", "Data2", "Data3", "Data4", "Data5", "Data6"
                ' Ignore these sheets
            Case Else
                r = shM.Range("A" & shM.Rows.Count).End(xlUp).Row + 1
                shM.Range("A" & r).Resize(38).Value = Sht.Name
            ' Copy range, then paste values
            Sht.Range("E65:BF66,E80:BF81,E94:BF95,E83:BF84,E96:BF97,E98:BF106,E68:BF69,E118:BF119,E132:BF133,E121:BF122,E134:BF135,E136:BF144").Copy
                shM.Range("B" & r).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        End Select
    Next Sht
    Application.ScreenUpdating = True
End Sub

Post by **HansV** » 14 Sep 2016, 16:01

I think you'll have to do it like this:

Code: Select all

            Sht.Range("E65:BF66,E80:BF81,E94:BF95").Copy
                shM.Range("B" & r).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            Sht.Range("E83:BF84,E96:BF106").Copy
                shM.Range("B" & r + 6).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            Sht.Range("E68:BF69,E118:BF119,E132:BF133").Copy
                shM.Range("B" & r + 19).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            Sht.Range(E121:BF122,E134:BF144").Copy
                shM.Range("B" & r + 25).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

JoeExcelHelp · Post by **JoeExcelHelp** » 14 Sep 2016, 20:53

Hi Hans,
For some reason this code leaves out data in the last 8 cells column A
I needed to remove rows because of the document size. The UVF record is part of 98 sheets in my WB and UVF is the last sheet
All other sheet records pull in fine but the last UVF is incomplete
and all sheets are identical

Code: Select all

Sub CombineAllData4()
    Dim shM As Worksheet
    Dim Sht As Worksheet
    Dim r As Long
    Application.ScreenUpdating = False
    Set shM = Worksheets("Data4")
    ' Clear the Data sheet
    shM.Range("2:" & shM.Rows.Count).ClearContents

    For Each Sht In ActiveWorkbook.Worksheets
        Select Case Sht.Name
            Case "Schedule", "Hours", "Attrition", "Orientation", "Actuals", "ClassDist", "Data", "Data2", "Data3", "Data4", "Data5", "Data6"
                ' Ignore these sheets
            Case Else
                r = shM.Range("A" & shM.Rows.Count).End(xlUp).Row + 1
                shM.Range("A" & r).Resize(38).Value = Sht.Name
            ' Copy range, then paste values
            
            Sht.Range("E65:BF66,E80:BF81,E94:BF95,E83:BF84,E96:BF106,E180:BF181,E164:BF165").Copy
                shM.Range("B" & r).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            
            Sht.Range("E68:BF69,E118:BF119,E132:BF133,E121:BF122,E134:BF144,E182:BF183,E166:BF167").Copy
                shM.Range("B" & r + 23).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            
        End Select
    Next Sht
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Post by **HansV** » 14 Sep 2016, 21:01

The total number of rows that you copy is now 46 instead of 38, so you should change

shM.Range("A" & r).Resize(38).Value = Sht.Name

to

shM.Range("A" & r).Resize(46).Value = Sht.Name

JoeExcelHelp · Post by **JoeExcelHelp** » 14 Sep 2016, 21:16

That was really silly on my part.. Thank You long day

JoeExcelHelp · Post by **JoeExcelHelp** » 14 Sep 2016, 22:27

Been making myself nuts over trying to find a code that performs a sumproduct
The WB I attached has within the first sheet a formula that Im trying to duplicate via code the source being the 2nd sheet
If you have something handy that would be great if not no big deal

Post by **HansV** » 14 Sep 2016, 22:39

The only SUMPRODUCT formula that I can find is the one in cell D5 on Sheet1, but it's not very enlightening:

=SUMPRODUCT((Sheet2!#REF!=$B5)*(Sheet2!#REF!=$C5)*(Sheet2!$C$1:$BC$1=D$4),Sheet2!#REF!)

Should it be something like

=SUMPRODUCT((Sheet2!$A$2:$A$1000=$B5)*(Sheet2!$B$2:$B$1000=$C5)*(Sheet2!$C$1:$BC$1=D$4),Sheet2!$C$2:$BC$1000)

If so, you can use code like this

Worksheets("Sheet1").Range("D5:Y27").FormulaR1C1 = "=SUMPRODUCT((Sheet2!R2C1:R1000C1=RC2)*(Sheet2!R2C2:R1000C2=RC3)*(Sheet2!R1C3:R1C55=R4C),Sheet2!R2C3:R1000C55)"

JoeExcelHelp · Post by **JoeExcelHelp** » 14 Sep 2016, 22:50

:) yes ur correct sorry about that

JoeExcelHelp · Post by **JoeExcelHelp** » 21 Sep 2016, 23:13

Yes, you are awesome.. Don't know how I missed that.. Long day

JoeExcelHelp · Post by **JoeExcelHelp** » 22 Sep 2016, 13:09

Hi Hans, Is it possible to exclude the formulas in each cell after the code is run?

Code: Select all

Sub SumHiringPlan()
Worksheets("HiringPlan").Range("D5:AA27").FormulaR1C1 = "=SUMPRODUCT((Data3!R2C1:R500C1=RC2)*(Data3!R2C2:R500C2=RC3)*(Data3!R1C3:R1C55=R4C),Data3!R2C3:R500C55)"
End Sub

Post by **HansV** » 22 Sep 2016, 13:12

Like this:

Code: Select all

Sub SumHiringPlan()
    With Worksheets("HiringPlan").Range("D5:AA27")
        .FormulaR1C1 = "=SUMPRODUCT((Data3!R2C1:R500C1=RC2)*(Data3!R2C2:R500C2=RC3)*(Data3!R1C3:R1C55=R4C),Data3!R2C3:R500C55)"
        .Value = .Value
    End With
End Sub

JoeExcelHelp · Post by **JoeExcelHelp** » 22 Sep 2016, 13:16

Thank You Hans.. and for the quick response

JoeExcelHelp · Post by **JoeExcelHelp** » 25 Sep 2016, 21:24

Hi Hans,

I need to adjust the following line to search if the word "Internal" exists
sFile & "C4,""<>""&""Internal""," & _

Post by **HansV** » 25 Sep 2016, 21:36

If the value of C4 should equal "Internal":

sFile & "C4,""Internal""," & _

If the value of C4 should contain "Internal" (plus possibly other text):

sFile & "C4,""*Internal*""," & _

JoeExcelHelp · Post by **JoeExcelHelp** » 25 Sep 2016, 21:59

Thank You Hans, happy to know Im not the only person working on a sunday :)

JoeExcelHelp · Post by **JoeExcelHelp** » 25 Sep 2016, 22:41

I think I need an "OR" statement for Business Partner and BP

Code: Select all

Set rgD = Intersect(shD.Range("Q1").CurrentRegion, shD.Range("Q1").CurrentRegion.Offset(1, 3))
    rgD.FormulaR1C1 = _
        "=SUMIFS(" & sFile & "C16," & _
        sFile & "C5,""=""&RC18," & _
        sFile & "C6,""=""&RC19," & _
        sFile & "C8,""=""&RC17," & _
        sFile & "C2,""=""&R1C," & _
        sFile & "C1,""<>""&""""," & _
        sFile & "C4,""*Business Partner*""," & _
        sFile & "C4,""*BP*"")"
    rgD.Value = rgD.Value

Post by **HansV** » 26 Sep 2016, 04:36

Conditions in SUMIFS are combined with AND, it doesn't provide for OR. You could use

Code: Select all

    rgD.FormulaR1C1 = _
        "=SUMIFS(" & sFile & "C16," & _
        sFile & "C5,""=""&RC18," & _
        sFile & "C6,""=""&RC19," & _
        sFile & "C8,""=""&RC17," & _
        sFile & "C2,""=""&R1C," & _
        sFile & "C1,""<>""," & _
        sFile & "C4,""*Business Partner*"")+" & _
        "SUMIFS(" & sFile & "C16," & _
        sFile & "C5,""=""&RC18," & _
        sFile & "C6,""=""&RC19," & _
        sFile & "C8,""=""&RC17," & _
        sFile & "C2,""=""&R1C," & _
        sFile & "C1,""<>""," & _
        sFile & "C4,""*BP*"")"

JoeExcelHelp · Post by **JoeExcelHelp** » 26 Sep 2016, 14:18

Thank You Hans

Eileen's Lounge

Adjust a Range

Adjust a Range

Re: Adjust a Range

Re: Adjust a Range

Re: Adjust a Range

Re: Adjust a Range

Re: Adjust a Range

Re: Adjust a Range

Re: Adjust a Range

Re: Adjust a Range

Re: Adjust a Range

Re: Adjust a Range

Re: Adjust a Range

Re: Adjust a Range

Re: Adjust a Range

Re: Adjust a Range

Re: Adjust a Range

Re: Adjust a Range

Re: Adjust a Range