VBA search cells in range with row skip

EMcK01

Board Regular
Joined
Jun 14, 2015
Messages
125
Hi,

Is there a way to get the following code to skip 3 rows when it finds the rngEnd to ensure it then defines the range as appropriate? The ranges vary within the sheet but there is always 3 clear rows from the end of block of data before the start of the next block of data.

VBA Code:
Sub Test2()

Dim rngC As Range
Dim LastR As Long

    LastR = Range("C" & Rows.Count).End(xlUp).Row
    Set rngC = Range("C18:C" & LastR) 'Range("C4:C" & LastR)
    
              For Each cell In rngC
                If cell.Value = "" Then
            
                    Dim rngStart As String
                    Dim rngEnd As String

                    cell.Offset(1, 0).Select
                    rngStart = ActiveCell.Address
                    fr = Range(rngStart).Row
                    
                    Selection.End(xlDown).Select
                    rngEnd = ActiveCell.Address
                    lr = Range(rngEnd).Row
                    
                    i = lr - fr
                        
                        cell.Offset(i + 3, 1).Formula = ("=SUM(D" & fr & ":D" & lr & ")")
                        cell.Offset(i + 3, 2).Formula = ("=SUM(E" & fr & ":E" & lr & ")")
                        cell.Offset(i + 3, 3).Formula = ("=SUM(F" & fr & ":F" & lr & ")")
                        cell.Offset(i + 3, 4).Formula = ("=SUM(G" & fr & ":G" & lr & ")")
                        cell.Offset(i + 3, 5).Formula = ("=SUM(H" & fr & ":H" & lr & ")")
                        cell.Offset(i + 3, 6).Formula = ("=SUM(I" & fr & ":I" & lr & ")")
                        cell.Offset(i + 3, 7).Formula = ("=SUM(J" & fr & ":J" & lr & ")")
                        cell.Offset(i + 3, 8).Formula = ("=SUM(K" & fr & ":K" & lr & ")")
                        
                        cell.Offset(i + 3, 12).Formula = ("=SUM(O" & fr & ":O" & lr & ")")
                        cell.Offset(i + 3, 13).Formula = ("=SUM(O" & lr + 2 & "/J" & lr + 2 & ")*100")

            End If
        Next cell
End Sub

Thanks,
EMcK
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Will C18 always be blank, or will the position of the 1st block vary?
Also are the values in col C constants or formulae?
 
Upvote 0
Hi Fluff,

C18 should be C4 or C6, I was checking something and forgot to put the code back.

The first 4 rows are headings and the first set of data starts on C6, this will always be constant.

Thanks
 
Upvote 0
Ok, how about
VBA Code:
Sub EMcK()
   Dim Rng As Range
   For Each Rng In Range("C6", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlConstants).Areas
      With Rng.Offset(Rng.Count + 1, 1)
         .Resize(1, 8).Formula = "=sum(" & Rng.Offset(, 1).Address(1, 0) & ")"
         .Offset(, 11).Resize(1, 1).Formula = "=sum(" & Rng.Offset(, 12).Address(1, 0) & ")"
         .Offset(, 12).Resize(1, 1).Formula = "=(" & .Offset(, 11).Resize(1, 1).Address & "/" & .Offset(, 6).Resize(1, 1).Address & ")*100"
      End With
   Next Rng
End Sub
 
Upvote 0
A slightly simplified version
VBA Code:
Sub EMcK()
   Dim Rng As Range
   For Each Rng In Range("C6", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlConstants).Areas
      With Rng.Offset(Rng.Count + 1, 0).Resize(1)
         .Offset(, 1).Resize(, 8).Formula = "=sum(" & Rng.Offset(, 1).Address(0, 0) & ")"
         .Offset(, 12).Formula = "=sum(" & Rng.Offset(, 12).Address(0, 0) & ")"
         .Offset(, 13).Resize(1, 1).Formula = "=(O" & .Row & "/J" & .Row & ")*100"
      End With
   Next Rng
End Sub
 
Upvote 0
Hi Fluff,

that works perfectly for me and so much slicker than anything that I can come up with. Thanks for taking the time to help me with this.

I need to add a final formula in row 3 that either adds the total of the sums that has been formed or adds all the blocks together.

Thanks again,
EMcK
 
Upvote 0
You're welcome & thanks for the feedback.
 
Upvote 0
To add the totals in row 3 you can use
VBA Code:
Sub EMcK()
   Dim Rng As Range
   Dim Str As String
   For Each Rng In Range("C6", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlConstants).Areas
      With Rng.Offset(Rng.Count + 1, 0).Resize(1)
         .Offset(, 1).Resize(, 8).Formula = "=sum(" & Rng.Offset(, 1).Address(0, 0) & ")"
         .Offset(, 12).Formula = "=sum(" & Rng.Offset(, 12).Address(0, 0) & ")"
         .Offset(, 13).Resize(1, 1).Formula = "=(O" & .Row & "/J" & .Row & ")*100"
         Str = Str & ",D" & .Row
      End With
   Next Rng
   Range("D3").Resize(, 8).Formula = "=sum(" & Mid(Str, 2) & ")"
End Sub
 
Upvote 0
Solution
Hi Fluff,

Thanks for the update last night, that extra line is perfect, I'll need take a wee bit if time to look at what you've provided.

As a final question on this, is there a way of speeding up the following code, it works fine but just seems a bit slow especially compared to what you have done.

Thanks again, its appreciated.
EMcK

VBA Code:
Sub AddFormula1()
Dim LastRowUsed As Long, rng1 As Range

    i = 5
    LastRowUsed = Range("C" & Rows.Count).End(xlUp).Row
                      
      Set rng1 = Range("C6:C" & LastRowUsed)
              For Each cell In rng1         
                i = i + 1
      
              If cell.Value <> "" Then 
                    Cells(i, 10).Formula = ("=IFERROR(I" & i & "-L" & i & " ,I" & i & ")")
                    Cells(i, 11).Formula = ("=E" & i & "-J" & i)
                    
                    Cells(i, 15).Formula = ("=(N" & i & "*D" & i & ")/100")
                    Cells(i, 16).Formula = ("=(O" & i & "/J" & i & ")*100")
            End If
        Next cell
End Sub
 
Upvote 0
As that is a totally different question, it needs a new thread. Thanks
 
Upvote 0

Forum statistics

Threads
1,213,560
Messages
6,114,309
Members
448,564
Latest member
ED38

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