i'm trying to write a macro to automatically resize a range to cells that have a greater than 0 value in a row - i have 12 columns for each month, and i want to make a range from only the cells that contain data.
The code i have so far seems to work, but it loops only once and stops on month 11.
Sub Charts_Update()
Dim TotFTE As Range, CellIndex As Range
Dim ColIndex As Long, i As Long
Set TotFTE = Sheets("FTE Detail").Range("E19:P19")
i = 12
With TotFTE
For ColIndex = .Cells(0, 16).End(xlToLeft).Column To 5 Step -1
With Columns(ColIndex)
If Application.Sum(.Cells) = 0 Then
i = i - 1
Set TotFTE = TotFTE.Offset(0, 0).Resize(1, i)
End If
End With
Next ColIndex
End With
End Sub
Any ideas to get it to go correctly through all columns? Any help much appreciated. Thanks
CodePudding user response：
I have multiple possible codes depending on what you want to achieve. In any case if no cell with numeric value is found (i maintained your way to formulate the condition via Application.Sum) or the appropriate range can't be determined in any other way, nothing is returned.
The first one is a modified version of your own code:
Sub Charts_Update1()
'Declarations.
Dim TotFTE As Range, CellIndex As Range
Dim ColIndex As Long, i As Long
'Settings
Set TotFTE = Sheets("FTE Detail").Range("E19:P19")
i = TotFTE.Columns.Count
'Focusing TotFTE.
With TotFTE
'Covering the cells from the most right cell with data to the left of cell(0, 16) to the firt column of TotFTE.
For ColIndex = .Cells(0, 16).End(xlToLeft).Column To TotFTE.Column Step -1
'Focusing the entire column with ColIndex index.
With Columns(ColIndex)
'Checking if the sum of the cell of TotFTE within the column with ColIndex index is 0.
If Application.Sum(Intersect(.Cells, TotFTE)) = 0 Then
'Setting i for the previous column.
i = i - 1
'If i is equal to 0, no result with a sum different from 0 has been found.
If i = 0 Then
'Setting TotFTE to nothing and terminating the macro.
Set TotFTE = Nothing
Exit Sub
End If
'Resizing TotFte.
Set TotFTE = TotFTE.Resize(1, i)
Else
'The first cell with a sum different than 0 most to the right in TotFTE has been found. The macro is terminated.
Exit Sub
End If
End With
Next ColIndex
End With
End Sub
It will return the range:
- from the cell on the left edge of the original TotFTE (even if empty or with text)
- to the first most right non-empty with non-text value to the left of the right edge of the original TotFTE
I wanted to have at least one code to be a modified version of your own. I will therefore maintain some criticality (like the using of the header to determine ColIndex).
The second one is a brand new code:
Sub Charts_Update2()
'Declarations.
Dim TotFTE As Range
Dim RngTarget As Range
'Settings.
Set TotFTE = Sheets("FTE Detail").Range("E19:P19")
Set RngTarget = TotFTE.Cells(1, 1)
'If the sum of RngTarget is zero, TotFTE is set to nothing and the macro is terminated.
If Application.Sum(RngTarget) = 0 Then
Set TotFTE = Nothing
Exit Sub
End If
'RngTarget is resized until its sum doesn't change anymore or it reaches the TotFTE range limit.
Do Until Application.Sum(RngTarget) = Application.Sum(RngTarget.Resize(, RngTarget.Columns.Count 1)) Or _
RngTarget.Columns.Count 1 > TotFTE.Columns.Count
Set RngTarget = RngTarget.Resize(, RngTarget.Columns.Count 1)
Loop
'Setting TotFTE.
Set TotFTE = RngTarget
End Sub
It will return the range:
- from the left edge of the original TotFTE only if non-empty with non-text value
- to the cell within the original TotFTE on the right edge of the first chunk of continuously satisfactory (non-empty with non-text value) data.
The third one is also a brand new code:
Sub Charts_Update3()
'Declarations.
Dim TotFTE As Range
Dim RngLeft As Range
Dim RngRight As Range
'Settings.
Set TotFTE = Sheets("FTE Detail").Range("E19:P19")
Set RngLeft = TotFTE.Cells(1, 1)
Set RngRight = TotFTE.Cells(1, TotFTE.Columns.Count)
'Checking if RngLeft sum is zero.
If Application.Sum(RngLeft.Value) = 0 Then
'Setting RngLeft as the firt cell with value to the right of RngLeft.
Set RngLeft = RngLeft.End(xlToRight)
'Checking if RngLeft has reached beyond the TotFTE limits or has a sum total of 0.
If RngLeft.Column > TotFTE.Column TotFTE.Columns.Count - 1 Or Application.Sum(RngLeft.Value) = 0 Then
'Setting TotFTE to nothing end terminating the sub.
Set TotFTE = Nothing
Exit Sub
End If
End If
'Checking if RngLeft sum is zero.
If Application.Sum(RngRight.Value) = 0 Then
'Setting RngRight as the firt cell with value to the left of Rngright.
Set RngRight = RngRight.End(xlToLeft)
End If
'Setting TotFTE.
Set TotFTE = Range(RngRight, RngLeft)
End Sub
It will return the range:
- from the most-left cell of the original TotFTE non-empty with non-text value
- to the most-right cell of the original TotFTE non-empty with non-text value.
It will include any empty and/or with text value between those 2 cells.
CodePudding user response：
I ran the code on an example sheet and a few things to note:
the .Cells(0,16) - as mentioned in the comments - this is actually the row above the row you define (in your example this would be row 18, the row above E19:P19), that cell would also be past your defined range (in the example it is T18)
the code will resize down if the final column (all of the column not just the part in the defined range, eg. P1:P1048576), sums to 0
an odd behaviour will happen if there is a column that sums to 0 prior to a column that does not. in this case the code will resize down by 1 but that will drop a column that does have data in it
if no columns have data in then your code will try to resize a range to null, that wont work and will throw an error.
Given these things the code does actually work, can you expand on what you're trying to do and what you mean by "but it loops only once and stops on month 11" and we can try to help to adjust the code to your use