Posts by ExcelChick

ExcelChick · Nov 20th 2013

Re: Pivot table Calculated Field - Is this possible?!

Are sumifs possible in calculated fields? Could I use something like this? So far it's not working

[TABLE="width: 60"]

[tr]

[TD="width: 60"]=IFERROR(SUMIFS(B3:B7,A3:A7,"Loads & Other Labor Costs")/SUMIFS(B3:B7,A3:A7,"Contract Hrs"),0)[/TD]

[/tr]

[/TABLE]

ExcelChick · Nov 20th 2013

Hello,

I am trying to create a pivot table with a calculated field that would effectively divide Loads & Other Labor Costs by Contract hours to get Loads & Other Labor Costs per hour.

See picture.
[ATTACH=CONFIG]57582[/ATTACH]

I don't know if this is possible since they both sit within the Metrics field?

any help would be awesome.

Thanks!

ExcelChick · Nov 20th 2013

Hello - I am trying to optimize this code so that I can easily call out this section of code multiple times. I cannot make it a sub procedure because it contains

Code

If ActiveCell.End(xlDown).Row = 1048576 Then Exit For

Code

'Dim this as something? or Set it? Make it a function?
counter1 = 1
Do Until counter1 > 9
If ActiveCell.End(xlDown).Row = 1048576 Then Exit For
ActiveCell.End(xlDown).Offset(z).ClearContents
ActiveCell.End(xlDown).Offset(z).Select
counter1 = counter1 + 1
Loop

Here's the current full code:

Code

Dim a As Integer
Dim z As Integer
Dim act As Range
Dim s As Range
Dim counter1 As Integer












Set s = Range("G2", Range("G" & Range("G1048576").End(xlUp).Row))




a = 63
z = 6




counter1 = 1
















Sheets("Sup_Data").Select
Range("G2").Select








For Each act In s




ActiveCell.Resize(16).ClearContents




counter1 = 1
Do Until counter1 > 9
If ActiveCell.End(xlDown).Row = 1048576 Then Exit For
ActiveCell.End(xlDown).Offset(z).ClearContents
ActiveCell.End(xlDown).Offset(z).Select
counter1 = counter1 + 1
Loop












ActiveCell.Resize(9).ClearContents




counter1 = 1
Do Until counter1 > 9
If ActiveCell.End(xlDown).Row = 1048576 Then Exit For




ActiveCell.End(xlDown).Offset(z).ClearContents
ActiveCell.End(xlDown).Offset(z).Select
counter1 = counter1 + 1
Loop




ActiveCell.Resize(8).ClearContents




counter1 = 1
Do Until counter1 > 9
If ActiveCell.End(xlDown).Row = 1048576 Then Exit For




ActiveCell.End(xlDown).Offset(z).ClearContents
ActiveCell.End(xlDown).Offset(z).Select
counter1 = counter1 + 1
Loop




ActiveCell.Resize(8).ClearContents




counter1 = 1
Do Until counter1 > 9
If ActiveCell.End(xlDown).Row = 1048576 Then Exit For




ActiveCell.End(xlDown).Offset(z).ClearContents
ActiveCell.End(xlDown).Offset(z).Select
counter1 = counter1 + 1
Loop




ActiveCell.Resize(10).ClearContents




counter1 = 1
Do Until counter1 > 9
If ActiveCell.End(xlDown).Row = 1048576 Then Exit For




ActiveCell.End(xlDown).Offset(z).ClearContents
ActiveCell.End(xlDown).Offset(z).Select
counter1 = counter1 + 1
Loop




ActiveCell.Resize(8).ClearContents




counter1 = 1
Do Until counter1 > 9
If ActiveCell.End(xlDown).Row = 1048576 Then Exit For




ActiveCell.End(xlDown).Offset(z).ClearContents
ActiveCell.End(xlDown).Offset(z).Select
counter1 = counter1 + 1
Loop




ActiveCell.Resize(23).ClearContents




counter1 = 1
Do Until counter1 > 9
If ActiveCell.End(xlDown).Row = 1048576 Then Exit For




ActiveCell.End(xlDown).Offset(z).ClearContents
ActiveCell.End(xlDown).Offset(z).Select
counter1 = counter1 + 1
Loop




ActiveCell.Resize(18).ClearContents








counter1 = 1
Do Until counter1 > 9
If ActiveCell.End(xlDown).Row = 1048576 Then Exit For




ActiveCell.End(xlDown).Offset(z).ClearContents
ActiveCell.End(xlDown).Offset(z).Select
counter1 = counter1 + 1
Loop




ActiveCell.Resize(9).ClearContents
ActiveCell.End(xlDown).Select
If ActiveCell.End(xlDown).Row = 1048576 Then Exit For








Next act








End Sub

Display More

Thanks!

ExcelChick · Nov 20th 2013

Re: vba clear contents of specific range in intervals loop

Here's what I ended up with using that seems to be working (in case others may benefit)

Code

Dim a As Integer
Dim act As Range
Dim s As Range




Set s = Range("G2", Range("G" & Range("G1048576").End(xlUp).Row))




a = 63




Range("G2").Select




Sheets("Sup_Data").Select




For Each act In s




ActiveCell.Resize(16).ClearContents
ActiveCell.End(xlDown).Offset(a).Select








ActiveCell.Resize(8).ClearContents
ActiveCell.End(xlDown).Offset(a).Select




ActiveCell.Resize(7).ClearContents
ActiveCell.End(xlDown).Offset(a).Select




ActiveCell.Resize(7).ClearContents
ActiveCell.End(xlDown).Offset(a).Select








ActiveCell.Resize(7).ClearContents
ActiveCell.End(xlDown).Offset(a + 2).Select








ActiveCell.Resize(7).ClearContents
ActiveCell.End(xlDown).Offset(a).Select








ActiveCell.Resize(22).ClearContents
ActiveCell.End(xlDown).Offset(a).Select








ActiveCell.Resize(7).ClearContents
ActiveCell.End(xlDown).Offset(a + 10).Select








ActiveCell.Resize(8).ClearContents
ActiveCell.End(xlDown).Select








If ActiveCell.End(xlDown).Row = 1048576 Then Exit For




Next act
Range("G2").Select

Display More

ExcelChick · Nov 19th 2013

Re: vba clear contents of specific range in intervals loop

Then I would have to call out every range in column G - I am trying to avoid that by using an offset of -63 somehow, then looping up to repeat for the next section of column G all the way down.

ExcelChick · Nov 19th 2013

Hello,

I am trying to delete specific cells in a pattern/interval. I do not want to use the ranges listed because I want it to loop all the way down the column.

'Clearcontents of G2:17 (Clear 16 cells)
'Clearcontents of G81:G88 (63 cells down from last clear, Clear 8 cells)
'Clearcontents of G152:158 (63 cells down from last clear, Clear 7 cells)
'Clearcontents of G222:228 (63 cells down from last clear, Clear 7 cells)
'Clearcontents of G292:298 (63 cells down from last clear, Clear 7 cells)
'Clearcontents of G364:370 (63 cells down from last clear, Clear 7 cells)
'Clearcontents of G434:455 (63 cells down from last clear, clear 22 cells)
'Clearcontents of G519:525 (63 cells down from last clear, Clear 7 cells)
'Clearcontents of G599:605 (73 cells down from last clear, Clear 7 cells)
'Loop to top of this for entire column

I don't have any code yet... any help would be appreciated!

Thanks!

ExcelChick · Nov 19th 2013

Re: Filtering for multiple values VBA

I recorded the macro and selected those values - I realized that I have a 2nd filter on a different column that is causing it to leave only 3 of the 5 selections. Issue resolved.

ExcelChick · Nov 19th 2013

Hello,

I recorded this macro to have 5 filter criteria, but when I run it it only selects 3 of the 5 criteria. Can someone please assist?

Code

Worksheets("Sup_Data").Range("$A$1:$Q$54436").AutoFilter Field:=9, Criteria1:=Array( _
    "Contract Hrs", "Loads & Other Labor Costs", "Supervised FTE", "Total Labor Costs", _
    "Unloaded Chg Payroll"), Operator:=xlFilterValues

Thanks!

ExcelChick · Nov 19th 2013

Re: Paste values under certain number of rows with worksheet array loop

Here's what I ended up using that worked!

Code

Dim LR as Long
y = Array("CAN", "USA", "ASG", "Gallia", "IGEM", "LAT", "NOR", "SPAI", "UKI", "ANZ", "ASE", "China", "IND", "JPN", "Skorea")




For Each x In y
With Worksheets(x)
LR = Worksheets("Sup_Data").Range("J1048576").End(xlUp).Row 'The order of this is very important!
.Range(.Cells(intRow_01, intCol_01), .Cells((intRow_01 + intGroup), intCol_07)).Copy
Worksheets("Sup_Data").Range("D" & LR).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_09), .Cells((intRow_01 + intGroup), intCol_09)).Copy
Worksheets("Sup_Data").Range("K" & LR).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_12), .Cells((intRow_01 + intGroup), intCol_12)).Copy
Worksheets("Sup_Data").Range("L" & LR).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_15), .Cells((intRow_01 + intGroup), intCol_15)).Copy
Worksheets("Sup_Data").Range("M" & LR).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_23), .Cells((intRow_01 + intGroup), intCol_23)).Copy
Worksheets("Sup_Data").Range("N" & LR).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_26), .Cells((intRow_01 + intGroup), intCol_26)).Copy
Worksheets("Sup_Data").Range("O" & LR).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_29), .Cells((intRow_01 + intGroup), intCol_29)).Copy
Worksheets("Sup_Data").Range("P" & LR).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_32), .Cells((intRow_01 + intGroup), intCol_32)).Copy
Worksheets("Sup_Data").Range("Q" & LR).Offset(1).PasteSpecial (xlPasteValues)












End With




Next

Display More

ExcelChick · Nov 19th 2013

Re: Paste values under certain number of rows with worksheet array loop

Quote from patel;692117

LR is a row number, the can be integer or long, did you solve ?

I was not able to solve
I tried to Dim as both an integer and Long with the code I just posted above.
The result is that when it loops through the 2nd worksheet it just pastes over the previous pasted values.
And when I hover over LR in the code it says "LR = 1" So it just keeps pasting in row 2.

ExcelChick · Nov 19th 2013

Re: Paste values under certain number of rows with worksheet array loop

What do I dim LR as? an integer? It doesn't work if I dim it as a Range...

So are you proposing that my updated code should be:

Code

Dim LR As Integer
LR = ActiveSheet.UsedRange.SpecialCells(xlLastCell, xlNumbers).Row


For Each x In y
With Worksheets(x)




.Range(.Cells(intRow_01, intCol_01), .Cells((intRow_01 + intGroup), intCol_07)).Copy
Worksheets("Sup_Data").Range("D" & LR).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_09), .Cells((intRow_01 + intGroup), intCol_09)).Copy
Worksheets("Sup_Data").Range("K" & LR).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_12), .Cells((intRow_01 + intGroup), intCol_12)).Copy
Worksheets("Sup_Data").Range("L" & LR).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_15), .Cells((intRow_01 + intGroup), intCol_15)).Copy
Worksheets("Sup_Data").Range("M" & LR).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_23), .Cells((intRow_01 + intGroup), intCol_23)).Copy
Worksheets("Sup_Data").Range("N" & LR).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_26), .Cells((intRow_01 + intGroup), intCol_26)).Copy
Worksheets("Sup_Data").Range("O" & LR).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_29), .Cells((intRow_01 + intGroup), intCol_29)).Copy
Worksheets("Sup_Data").Range("P" & LR).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_32), .Cells((intRow_01 + intGroup), intCol_32)).Copy
Worksheets("Sup_Data").Range("Q" & LR).Offset(1).PasteSpecial (xlPasteValues)


End With




Next

Display More

ExcelChick · Nov 19th 2013

Hello,

I am trying to have the macro loop through the worksheets, copy data, paste to another tab, under the last set of data each time. The issue is that when I use the below, the column of data that was originally pasted in does not go all the way to the bottom of the rows where there is data in other columns.

Code

.Range("D" & Rows.Count).End(xlUp).Offset(1)

For example in the picture you can see there are blanks in column D but the data for the Quarters to the right are populated. (These Quarter columns are not continuous data either/have blanks so using the above code in a similar fashion won't work I don't think?)

[ATTACH=CONFIG]57541[/ATTACH]

The only way I can think of is to run through the first work sheet as listed below, then the other worksheets with something like:

Code

Worksheets("Sup_Data").Range("D" & intgroup).Offset(1).PasteSpecial (xlPasteValues)

But this only results in pasting over the same cells each time. I'd need each subsequent sheet to be intgroup *2 or something?

Code

Dim intCounter, intIndex, intConvert As Integer
 Const intRow_01 As Integer = 21
 Const intRow_02 As Integer = 2
 Const intCol_01 As Integer = 1
 Const intCol_02 As Integer = 2
 Const intCol_03 As Integer = 3
 Const intCol_07 As Integer = 7
 Const intCol_09 As Integer = 9
 Const intCol_12 As Integer = 12
 Const intCol_15 As Integer = 15
 Const intCol_23 As Integer = 23
 Const intCol_26 As Integer = 26
 Const intCol_29 As Integer = 29
 Const intCol_32 As Integer = 32
 Const CMTRow As Integer = 588
 Const CSGRows As Integer = 606




Public Const intGroup As Integer = 3612




Public Const intRow_68 As Integer = 68
Dim strNew, strOld As String




Dim x As Variant
Dim y As Variant






'Copy and paste Supervised data into Sup_Data Tab
y = Array("CAN", "USA", "ASG", "Gallia", "IGEM", "LAT", "NOR", "SPAI", "UKI", "ANZ", "ASE", "China", "IND", "JPN", "Skorea")
For Each x In y
With Worksheets(x)








.Range(.Cells(intRow_01, intCol_01), .Cells((intRow_01 + intGroup), intCol_07)).Copy
Worksheets("Sup_Data").Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_09), .Cells((intRow_01 + intGroup), intCol_09)).Copy
Worksheets("Sup_Data").Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_12), .Cells((intRow_01 + intGroup), intCol_12)).Copy
Worksheets("Sup_Data").Range("L" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_15), .Cells((intRow_01 + intGroup), intCol_15)).Copy
Worksheets("Sup_Data").Range("M" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_23), .Cells((intRow_01 + intGroup), intCol_23)).Copy
Worksheets("Sup_Data").Range("N" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_26), .Cells((intRow_01 + intGroup), intCol_26)).Copy
Worksheets("Sup_Data").Range("O" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_29), .Cells((intRow_01 + intGroup), intCol_29)).Copy
Worksheets("Sup_Data").Range("P" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_32), .Cells((intRow_01 + intGroup), intCol_32)).Copy
Worksheets("Sup_Data").Range("Q" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)




End With




Next

Display More

Any help would be greatly appreciated!

Thank you!

ExcelChick · Nov 19th 2013

Re: Pivot Table with multiple columns

This is what I came up with after looking around the internet - I don't know how to make the pivot fields an array - but this is getting me what I need. Maybe this will help others!

Code

'PIVOT TABLE
Dim objTable As PivotTable
Dim objField As PivotField












    ActiveWorkbook.Sheets("Sup_Data(2)").Select
    Range("A1").Select
    Set objTable = Sheets("Sup_Data(2)").PivotTableWizard




    ActiveWindow.DisplayGridlines = False
    ActiveSheet.Name = "Supervised Pivot"
'
    Set objField = objTable.pivotfields("Metric")
    objField.Orientation = xlRowField








  
    




    Set objField = objTable.pivotfields("Q1 FY13")
    objField.Orientation = xlDataField
    objField.Function = xlSum
     objField.NumberFormat = "#,##0_);[Red](#,##0)"
     objField.Caption = "Q1_FY13"
 
'
     Set objField = objTable.pivotfields("Q2 FY13")
    objField.Orientation = xlDataField
    objField.Function = xlSum
     objField.NumberFormat = "#,##0_);[Red](#,##0)"
     objField.Caption = "Q2_FY13"




     Set objField = objTable.pivotfields("Q3 FY13")
    objField.Orientation = xlDataField
    objField.Function = xlSum
    objField.NumberFormat = "#,##0_);[Red](#,##0)"
    objField.Caption = "Q3_FY13"




     Set objField = objTable.pivotfields("Q4 FY13")
    objField.Orientation = xlDataField
    objField.Function = xlSum
    objField.NumberFormat = "#,##0_);[Red](#,##0)"
    objField.Caption = "Q4_FY13"




     Set objField = objTable.pivotfields("Q1 FY14")
    objField.Orientation = xlDataField
    objField.Function = xlSum
    objField.NumberFormat = "#,##0_);[Red](#,##0)"
    objField.Caption = "Q1_FY14"




    Set objField = objTable.pivotfields("Q2 FY14")
    objField.Orientation = xlDataField
    objField.Function = xlSum
    objField.NumberFormat = "#,##0_);[Red](#,##0)"
    objField.Caption = "Q2_FY14"
 




    Set objField = objTable.pivotfields("Q3 FY14")
    objField.Orientation = xlDataField
    objField.Function = xlSum
    objField.NumberFormat = "#,##0_);[Red](#,##0)"
    objField.Caption = "Q3_FY14"




    Set objField = objTable.pivotfields("Q4 FY14")
    objField.Orientation = xlDataField
    objField.Function = xlSum
    objField.NumberFormat = "#,##0_);[Red](#,##0)"
    objField.Caption = "Q4_FY14"




'Moves Values to Columns in pivot
 Set objField = objTable.pivotfields("Data")
objField.Orientation = xlColumnField

Display More

ExcelChick · Nov 18th 2013

Hello all,

I am trying to create a pivot table that has "Metric" in the Rows and the sum of Q1-Q4 FY13 & 14 into the columns. All of the numerical values sit under the headers Q1 etc. So the data looks like this:

[TABLE="width: 652"]

[tr]

[td]

Metric

[/td]

[td]

Q1 FY13

[/td]

[td]

Q2 FY13

[/td]

[td]

Q3 FY13

[/td]

[td]

Q4 FY13

[/td]

[td]

Q1 FY14

[/td]

[td]

Q2 FY14

[/td]

[td]

Q3 FY14

[/td]

[td]

Q4 FY14

[/td]

[/tr]

[tr]

[td]

Unloaded Chg Payroll

[/td]

[TD="align: right"]101.819[/TD]
[TD="align: right"]95.60698[/TD]
[TD="align: right"]113.3032[/TD]
[TD="align: right"]157.2209[/TD]
[TD="align: right"]231.1385[/TD]
[TD="align: right"]401.4415[/TD]
[TD="align: right"]525.2051[/TD]
[TD="align: right"]473.9572[/TD]

[/tr]

[tr]

[td]

Unloaded Chg Payroll

[/td]

[TD="align: right"]210.7658[/TD]
[TD="align: right"]56.87322[/TD]
[TD="align: right"]55.68585[/TD]
[TD="align: right"]15.40472[/TD]
[TD="align: right"]24.31954[/TD]
[TD="align: right"]39.38726[/TD]
[TD="align: right"]53.65847[/TD]
[TD="align: right"]48.42264[/TD]

[/tr]

[tr]

[td]

Unloaded Chg Payroll

[/td]

[TD="align: right"]-1.73045[/TD]
[TD="align: right"]65.64151[/TD]
[TD="align: right"]135.621[/TD]
[TD="align: right"]59.11858[/TD]
[TD="align: right"]93.33092[/TD]
[TD="align: right"]151.1562[/TD]
[TD="align: right"]205.9247[/TD]
[TD="align: right"]185.8312[/TD]

[/tr]

[tr]

[td]

Unloaded Chg Payroll

[/td]

[TD="align: right"]93.13438[/TD]
[TD="align: right"]15.52834[/TD]
[TD="align: right"]9.75809[/TD]
[TD="align: right"]53.07859[/TD]
[TD="align: right"]83.79554[/TD]
[TD="align: right"]135.713[/TD]
[TD="align: right"]184.8859[/TD]
[TD="align: right"]166.8453[/TD]

[/tr]

[/TABLE]

This is what I have - but it's not working

Code

Sub Macro1()
'
' Macro1 Macro
Dim objTable As PivotTable
Dim objField As PivotField




'




    ActiveWorkbook.Sheets("Sup_Data(2)").Select
    Range("A1").Select
    Set objTable = Sheets("Sup_Data(2)").PivotTableWizard
    
    ActiveWindow.DisplayGridlines = False
    
    Set objField = objTable.PivotFields("Metric")
    objField.Orientation = xlRowField
    
    
 With ActiveSheet.PivotTables("PivotTable1").AddDataField.ActiveSheet _
.PivotTables("PivotTable1").PivotFields ("Q1 FY13"), "Q2 FY13", xlSum
.PivotTables("PivotTable1").PivotFields ("Q2 FY13"), "Q2 FY13", xlSum
 .PivotTables("PivotTable1").PivotFields ("Q3 FY13"), "Q2 FY13", xlSum
.PivotTables("PivotTable1").PivotFields ("Q4 FY13"), "Q2 FY13", xlSum
.PivotTables("PivotTable1").PivotFields ("Q1 FY14"), "Q2 FY14", xlSum
.PivotTables("PivotTable1").PivotFields ("Q2 FY14"), "Q2 FY14", xlSum
.PivotTables("PivotTable1").PivotFields ("Q3 FY14"), "Q2 FY14", xlSum
.PivotTables("PivotTable1").PivotFields ("Q4 FY14"), "Q2 FY14", xlSum
 End With
End Sub

Display More

I would also like to format all the fields .NumberFormat = " #,##0" at the same time.
And rename the sheet "Supervised Pivot"

Can anyone assist?

Thanks,

ExcelChick · Nov 15th 2013

Re: Fillup blank cells with cell below until column is populated

Quote from S O;691715

True, as there is no loop, however Jindon's code assumes there is a value adjacent to the blank cell, which is why I'm assuming it didn't work originally.

This is correct - it was only filling up one cell - it wouldn't loop through to fill the remaining blanks.

Thank you all for your help!

ExcelChick · Nov 15th 2013

Re: Fillup blank cells with cell below until column is populated

This worked perfectly for me! Thank you!

Code

'Fills/copies the WF/WG up to blank cells
  Dim c As Range
  Dim r As Range
    Sheets("Sup_Data").Select
  Set r = Range("G2", Range("g" & Rows.Count).End(xlUp))
  
  For Each c In r
    On Error Resume Next
    If c = "" Then c = c.End(xlDown)
  Next c
  
  r(1.1).Select

Display More

ExcelChick · Nov 14th 2013

Re: Loop code through certain worksheets

I think I love you.

Thank you!

ExcelChick · Nov 14th 2013

Re: Fillup blank cells with cell below until column is populated

This fills down in the same fashion I'd like it to fill up. But when I change the -1 to a 1 it only fills up 1 cell.

ExcelChick · Nov 14th 2013

Hello,

I am trying to loop the following code for a total of 15 worksheets without copying and pasting that same code 14 more times for each worksheet. Right now it is only executing the code on the "CAN" tab. Is there a way to make it loop where indicated below?

The 15 worksheets are:
CAN
USA
ASG
Gallia
IGEM
LAT
NOR
SPAI
UKI
ANZ
ASE
China
IND
JPN
Skorea

Is it better to use Sheet(1) rather than the names of the tabs?

Code

Public Sub Supervised_Data_Build()
    subUnprotect
    Application.Calculation = xlCalculationManual
    ActiveSheet.DisplayPageBreaks = False
    Application.ScreenUpdating = False
 
'Unfilter
    Sheets("Sup_Data").Select
    If ActiveSheet.FilterMode Then
    ActiveSheet.ShowAllData
    End If
    
'Clear Existing Entries
    Sheets("Sup_Data").Select
    Range("A2:Q1048576").Select
    Selection.Clear
    
    Sheets("Sup_Data(2)").Select
    Range("A2:Q1048576").Select
    Selection.Clear
    
'LOOP THROUGH WORKSHEETS WOULD START HERE
'Copy and paste Supervised data into Sup_Data Tab
With Worksheets("CAN")




.Range(.Cells(intRow_01, intCol_01), .Cells((intRow_01 + intGroup), intCol_07)).Copy
Worksheets("Sup_Data").Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_09), .Cells((intRow_01 + intGroup), intCol_09)).Copy
Worksheets("Sup_Data").Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_12), .Cells((intRow_01 + intGroup), intCol_12)).Copy
Worksheets("Sup_Data").Range("L" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_15), .Cells((intRow_01 + intGroup), intCol_15)).Copy
Worksheets("Sup_Data").Range("M" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_23), .Cells((intRow_01 + intGroup), intCol_23)).Copy
Worksheets("Sup_Data").Range("N" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_26), .Cells((intRow_01 + intGroup), intCol_26)).Copy
Worksheets("Sup_Data").Range("O" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_29), .Cells((intRow_01 + intGroup), intCol_29)).Copy
Worksheets("Sup_Data").Range("P" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)




.Range(.Cells(intRow_01, intCol_32), .Cells((intRow_01 + intGroup), intCol_32)).Copy
Worksheets("Sup_Data").Range("Q" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)




End With




    
'Inserts CSG Name
'CMT
    Worksheets("CAN").Range("$F$5").Copy
    Worksheets("Sup_Data").Range("C" & Rows.Count).End(xlUp).Offset(1).Resize(CMTRow).PasteSpecial (xlPasteValues)
'FS
    Worksheets("CAN").Range("$F$610").Copy
    Worksheets("Sup_Data").Range("C" & Rows.Count).End(xlUp).Offset(1).Resize(CSGRows).PasteSpecial (xlPasteValues)
'HPS
    Worksheets("CAN").Range("$F$1215").Copy
    Worksheets("Sup_Data").Range("C" & Rows.Count).End(xlUp).Offset(1).Resize(CSGRows).PasteSpecial (xlPasteValues)
'PRD
    Worksheets("CAN").Range("$F$1820").Copy
    Worksheets("Sup_Data").Range("C" & Rows.Count).End(xlUp).Offset(1).Resize(CSGRows).PasteSpecial (xlPasteValues)
'RES
    Worksheets("CAN").Range("$F$3030").Copy
    Worksheets("Sup_Data").Range("C" & Rows.Count).End(xlUp).Offset(1).Resize(CSGRows).PasteSpecial (xlPasteValues)
'Other
    Worksheets("CAN").Range("$F$3030").Copy
    Worksheets("Sup_Data").Range("C" & Rows.Count).End(xlUp).Offset(1).Resize(CSGRows).PasteSpecial (xlPasteValues)
'SG_CD
    Worksheets("CAN").Range("$B$1").Copy
    Worksheets("Sup_Data").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(intGroup).PasteSpecial (xlPasteValues)
'GU
    Worksheets("CAN").Range("$B$2").Copy
    Worksheets("Sup_Data").Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(intGroup).PasteSpecial (xlPasteValues)
    
'WANT to have it loop here to next worksheet 




'Filter for wanted data
   
    Worksheets("Sup_Data").Range("$A$1:$Q$1048576").AutoFilter Field:=9, Criteria1:=Array( _
    "Contract Hrs", "Supervised FTE", "Total Labor Costs", "Unloaded Chg Payroll"), _
    Operator:=xlFilterValues
    Worksheets("Sup_Data").Range("$A$1:$Q$8964").AutoFilter Field:=5, Criteria1:="<>"
    
    
    
    Dim LastRow As Integer
    LastRow = [A1048576].End(xlUp).Row




'Copy Visable Values
    Sheets("Sup_Data").Select
    Range("A2:Q1048576").Select
    Selection.SpecialCells(xlCellTypeVisible).Copy




'Paste Values to Sup_Data(2) worksheet
    Worksheets("Sup_Data(2)").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    
    Application.ScreenUpdating = True




'Save Sup_data(2)to new workbook
    'Sheets("Sup_Data(2)").Select
    'Sheets("Sup_Data(2)").Copy
    'Application.DisplayAlerts = False
    'ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & "Supervised Stacked Data" & ".xlsx", _
    'FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    'Application.DisplayAlerts = True
    'ActiveWorkbook.Close Saved = False
  




    
End Sub

Display More

Thanks as always for your help!

ExcelChick · Nov 14th 2013

Hello,

I am creating a worksheet that will become a pivot table so I need the column G to be filled in for all rows. I would like it to loop through column G until it hits the last row (which may vary).
The data looks something like this
G2:G7 Blank
G8 Text to fill up
Repeats blanks and data

Would like to have text from G8 Fillup to G2:G7 or up until it hits another cell that has data in it. This is what I have right now - but it does not fill all the way up. It only fills up to G7:

Code

Public Sub tester()




  Dim c As Range
  Dim r As Range
Sheets("Sup_Data").Select
  Set r = Range("G2:G5000")
  
  For Each c In r
    On Error Resume Next
    If c = "" Then c = c.Offset(1, 0)
  Next c
  
  r(1.1).Select




End Sub

Display More

Any help would be greatly appreciated!

Thanks!