Offset only visible cells

sdoppke

Well-known Member
Joined
Jun 10, 2010
Messages
647
Hi everyone, I have this code below and was hoping to get help modifying it to offset only only visible cells.

Code:
If ActiveSheet.Range("X34").Value > 0 Then
HrBdg = ActiveSheet.Range("X34").Value
For i = 1 To HrBdg
Range("X33").End(xlUp).Offset(1).Value = "1"
Next i
End If

Thanks in advance for any help.

sd
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Hi everyone, I have this code below and was hoping to get help modifying it to offset only only visible cells.

Code:
If ActiveSheet.Range("X34").Value > 0 Then
HrBdg = ActiveSheet.Range("X34").Value
For i = 1 To HrBdg
Range("X33").End(xlUp).Offset(1).Value = "1"
Next i
End If

Thanks in advance for any help.

sd

This seems like a painful solutions, but there is a hidden property you could check, documented here. To do this you'd have to check and if both the row and column of that cell are visible then run your desired code. You might want to wait and see if anyone else has a better idea, but I figured I'd post this in case you didn't get any other responses. Good luck!
~Mathchick
 
Upvote 0
This might not be the best possible way to do it but it seems to work:
Code:
Dim c As Range
Dim Rng As Range
Dim HrBdg As Long

If ActiveSheet.Range("X34").Value > 0 Then
    
    HrBdg = ActiveSheet.Range("X34").Value
    
    Set c = Range("X33").End(xlUp)
    Set Rng = Range(c, Range("X33")).SpecialCells(xlCellTypeVisible)
        
    If Rng.Cells.Count > HrBdg Then
        
        For i = 1 To HrBdg
Back:
            Set c = c.Offset(1)
            
                If Not Intersect(c, Rng) Is Nothing Then
                    c.Value = "1"
                Else
                    GoTo Back
                End If
        Next i
    Else
        'What if there's not enough visible cells?
    End If
End If
 
Upvote 0
I came up with this idea, but it seems to think rows are hiddend when they are not?

Code:
If ActiveSheet.Range("X34").Value > 0 Then
Hrs = ActiveSheet.Range("X34").Value
For i = 1 To Hrs
Range("X33").End(xlUp).Offset(1).Select
Do Until ActiveCell.EntireRow.Hidden = False
Range("X33").End(xlUp).Offset(1).Value = "1"
Loop
Next i
End If

sd
 
Upvote 0
This might not be the best possible way to do it but it seems to work:
Code:
Dim c As Range
Dim Rng As Range
Dim HrBdg As Long
 
If ActiveSheet.Range("X34").Value > 0 Then
 
    HrBdg = ActiveSheet.Range("X34").Value
 
    Set c = Range("X33").End(xlUp)
    Set Rng = Range(c, Range("X33")).SpecialCells(xlCellTypeVisible)
 
    If Rng.Cells.Count > HrBdg Then
 
        For i = 1 To HrBdg
Back:
            Set c = c.Offset(1)
 
                If Not Intersect(c, Rng) Is Nothing Then
                    c.Value = "1"
                Else
                    GoTo Back
                End If
        Next i
    Else
        'What if there's not enough visible cells?
    End If
End If

This worked good. I appreciate the help. Im going to go out on a limb and ask if you can help me take it one step further...

Would you know howmost efficiently, run the same code over and over till it completes a range. to clarify, instead of starting with column x. I would start form column D (run this scrip and then do the same in every other column, until I hit column BR.

Well thanks for hangin in there and for any help or direction.

sd
 
Upvote 0
Try:
Code:
Sub EveryOtherColumn()

Dim j As Integer
Dim c As Range
Dim Rng As Range
Dim HrBdg As Long

For j = 4 To 70 Step 2
    If Cells(34, j).Value > 0 Then
    
    HrBdg = Cells(34, j).Value
 
    Set c = Cells(33, j).End(xlUp)
    Set Rng = Range(c, Cells(33, j)).SpecialCells(xlCellTypeVisible)
 
       If Rng.Cells.Count > HrBdg Then
    
           For i = 1 To HrBdg
Back:
               Set c = c.Offset(1)
    
                   If Not Intersect(c, Rng) Is Nothing Then
                       c.Value = "1"
                   Else
                       GoTo Back
                   End If
           Next i
       Else
           'What if there's not enough visible cells?
       End If
    End If
Next j

End Sub
 
Upvote 0
Try:
Code:
Sub EveryOtherColumn()
 
Dim j As Integer
Dim c As Range
Dim Rng As Range
Dim HrBdg As Long
 
For j = 4 To 70 Step 2
    If Cells(34, j).Value > 0 Then
 
    HrBdg = Cells(34, j).Value
 
    Set c = Cells(33, j).End(xlUp)
    Set Rng = Range(c, Cells(33, j)).SpecialCells(xlCellTypeVisible)
 
       If Rng.Cells.Count > HrBdg Then
 
           For i = 1 To HrBdg
Back:
               Set c = c.Offset(1)
 
                   If Not Intersect(c, Rng) Is Nothing Then
                       c.Value = "1"
                   Else
                       GoTo Back
                   End If
           Next i
       Else
           'What if there's not enough visible cells?
       End If
    End If
Next j
 
End Sub


Again, worked perfect, thank you so much.

sd
 
Upvote 0

Forum statistics

Threads
1,213,501
Messages
6,114,010
Members
448,543
Latest member
MartinLarkin

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