0

I have a range of cells which I'm scanning if the cell has a formular or not. When it does, I want to save the column letters and row numbers i.e. E14, E18, F18, N18 (Reference) do a dictionary. Once I've looped through my specific range, I want to select the cells saved in the dictionary to later on delete all cells with formulas in the selected cells.

I am stuck with the part to safe the cell reference to the dictionary. The range in the example is just an example range.

Sub check_formula_empty()

Dim cell As Range
Dim i As Integer
Dim rng As Range
Set rng = Range("E13:N19")

For i = 1 To rng.Cells.Count

    If rng.Cells(i).HasFormula = True And rng.Cells(i).Offset(-6, 0) = "A" Then

   'save reference range to Dictionary
    
    ElseIf rng.Cells(i).HasFormula = False And rng.Cells(i).Offset(-6, 0) = "F" Then
        
    rng.Cells(i).Offset(-4, 0).Copy _
    Destination:=rng.Cells(i)

    End If

Next

'Here I want to run the "Select my saved range from the Dictionary" and run "delete formulas"

End Sub
TheQ
  • 1
  • 3
    Typical approach here would be to build a Range using `Application.Union` E.g. from earlier today: https://stackoverflow.com/questions/71575425/how-to-insert-a-blank-row-based-on-cell-value/71575647#71575647 – Tim Williams Mar 22 '22 at 18:54

3 Answers3

0

You can us a collection for this purpose. You are mentioning a dictionary but for your purpose a key is not that important, you only need a list of items (collection supports both)

Sub check_formula_empty()

Dim cell As Range
Dim i As Integer
Dim rng As Range
Set rng = Range("E13:N19")
dim reflist as Collection
Set reflist = new Collection
For i = 1 To rng.Cells.Count

    If rng.Cells(i).HasFormula = True And rng.Cells(i).Offset(-6, 0) = "A" Then

   'save reference range to Dictionary
        refList.Add rng.Cells(i)
    ElseIf rng.Cells(i).HasFormula = False And rng.Cells(i).Offset(-6, 0) = "F" Then
        
    rng.Cells(i).Offset(-4, 0).Copy _
    Destination:=rng.Cells(i)

    End If

Next

'Here I want to run the "Select my saved range from the Dictionary" and run "delete formulas"

Dim oneCell as Range

    foreach oneCell in refList
        oneCell.Value = vbEmpty
    next
End Sub

As you can see we first add the complete cell to the collectdion (it is a referenced object) and later you can use it in the foreach loop to your liking with all its properties

Aldert
  • 4,209
  • 1
  • 9
  • 23
  • Thank you aldert for the quick one, works just nice! Is there a possibility to select the found range in refList in one go, without the foreach loop? I would like to save the ranges in refList as an example and once I've looped through my range, select all found cells at once and run vbEmpty. Is that even possible? – TheQ Mar 23 '22 at 07:11
0

So I was working on resolving the issue to run the VBA faster than looping 2-3x through each column.

My current issue, which I struggle to resolve is: that the defined range "nof" or "DBRW" keeps to increase, which when resolving my final code (delete or copy formula to the Union ranges), the whole Union ranges are selected and therefore formulars are overwritten for the full range, instead of looping from column to column and using the defined formula in that column, which is available in a fixed row (Cells(6, n)).


Option Explicit

Sub Test3()

Dim i As Integer
Dim n As Integer
Dim x As Integer

Dim DBRW As Range
Dim DBRWrange(1 To 32) As Range
Dim nof As Range
Dim nofRange(1 To 32) As Range
Dim rangef As Range

    For n = 5 To 6
        For i = 13 To 20
            If Cells(i, n).HasFormula = True And Cells(7, n) = "A" Then
               
        
                Set DBRWrange(i) = Cells(i, n)
                    If DBRW Is Nothing Then
                        Set DBRW = DBRWrange(i)
                        Else
                        Set DBRW = Union(DBRW, DBRWrange(i))
                    End If
                
            ElseIf Cells(i, n).HasFormula = False And Cells(7, n) = "F" Then
            
                Set nofRange(i) = Cells(i, n)
                    If nof Is Nothing Then
                        Set nof = nofRange(i)
                        Else
                        Set nof = Union(nof, nofRange(i))
                    End If

            End If

        Next i
        
        Set rangef = Cells(6, n)

        rangef.Copy nof
        

'Ranges in nof and DBRW are kept (incremented), is there a way to "refresh" the Union reference, to restart creating the range from after this step?

    Next n

End Sub


´´´
TheQ
  • 1
0

so I have solved my issue and for future googlers, this might be helpful :)

Public Sub copy_paste_delete()

Dim i As Integer
Dim n As Integer

Dim DBRW As Range
Dim DBRWrange(1 To 150) As Range
Dim nof As Range
Dim nofRange(1 To 150) As Range
Dim rangef As Range

Application.ScreenUpdating = False

Worksheets("Tab1").Activate
Range("K29").Select

Set DBRW = Nothing
Set nof = Nothing

    For n = 61 To 75
    
    Set nof = Nothing
    Set DBRW = Nothing
    
        For i = 33 To 38
            If Cells(i, n).HasFormula = True And Cells(6, n) = "F" Then
        
                Set DBRWrange(i) = Cells(i, n)
                    If DBRW Is Nothing Then
                        Set DBRW = DBRWrange(i)
                        Else
                        Set DBRW = Union(DBRW, DBRWrange(i))
                    End If
                
                
            ElseIf Cells(i, n).HasFormula = False And Cells(6, n) = "A" And Cells(7, n) = "Done" Then
            
                Set nofRange(i) = Cells(i, n)
                     If nof Is Nothing Then
                        Set nof = nofRange(i)
                        Else
                        Set nof = Union(nof, nofRange(i))
                    End If
            End If
        Next i
                        Set rangef = Cells(19, n)
                        
                        On Error Resume Next
                        
                        rangef.Copy nof
   
    Next n

DBRW.Select
'Do some stuff

Application.ScreenUpdating = True

End Sub

TheQ
  • 1