Two dimensions: collection or dynamic array

[Archangelos]

Hello guys,

I need a little help.

I have written a piece of code in order to perform massive replacement in the entire workbook.

Sub fdfd()

Dim SheetCounter As Integer


Dim RowCounter As Integer
Dim ColumnCounter As Integer


For SheetCounter = 1 To ThisWorkbook.Sheets.Count


    Sheets(SheetCounter).Activate
    For RowCounter = 4 To 20
        For ColumnCounter = 3 To 11
            Cells(RowCounter, ColumnCounter).Replace What:="p. cloudy", Replacement:="Partially cloudy", LookAt:=xlWhole  'HERE: first      pair (replace what, replace with)
            Cells(RowCounter, ColumnCounter).Replace What:="clear", Replacement:="Clear sky", LookAt:=xlWhole                 'HERE: second pair (replace what, replace with)
            Cells(RowCounter, ColumnCounter).Replace What:="cloudy", Replacement:="Cloudy", LookAt:=xlWhole                  'HERE: third     pair (replace what, replace with)
            Cells(RowCounter, ColumnCounter).Replace What:="rain", Replacement:="Rain", LookAt:=xlWhole                         'HERE: fourth    pair (replace what, replace with)


        Next ColumnCounter
    Next RowCounter


Next SheetCounter






End Sub

The code works fine. However, there is something that bothers me. I have to call the command « Cells(RowCounter, ColumnCounter).Replace ... ...» many times. I would like to make a Collection, nest a third for...loop in the two existing nested for...loop and navigate through the Collection's contents.





I have done something that works with a Collection.

Dim MetritisRBP As Integer
Dim LastRowInSheetRBP As Integer
Dim PlaceColl As Collection
Dim MegalosMetritis As Long
Dim StringFromColl As String
    'Eliminate proccess
   
    Call s3001_CopyToNewSheet("02_MarkACM", "03_FilterBandPol", 1, 27)
    Sheets("03_FilterBandPol").Activate
    LastRowInSheetRBP = s3002_LastRowWithData("03_FilterBandPol", StiliBPlaceName)
   
    Set PlaceColl = New Collection
    'PlaceColl.Add "9E HV"
    PlaceColl.Add "42E HH"
    PlaceColl.Add "3W LV"
    PlaceColl.Add "3W LH"
    PlaceColl.Add "10E HH"
    PlaceColl.Add "10E CR"
    PlaceColl.Add "10E CL"
 
 
    If PlaceColl.Count > 0 Then
   
       For MetritisRBP = LastRowInSheetRBP To 1 Step -1
           For MegalosMetritis = 1 To PlaceColl.Count
               If Cells(MetritisRBP, StiliBPlaceName) = PlaceColl(MegalosMetritis) Then
                  Rows(MetritisRBP).Delete
               End If
           Next MegalosMetritis
       Next MetritisRBP
    End If

The code above works but ... ... here comes the big Bee Yu Tee. In order to apply the Collection thing in the first code, I need a two-dimension Collection. Can it be done?

I am thinking of adding records to a Cellection and then navigate through the contents of the Collection.

Any help would be appreciated.

 

[Marcelo Branco]

Maybe something like this (no loops)

Sub aTest()
    Dim dic As Object, RngToClean As Range, vKey As Variant
    Dim SheetCounter As Long
    
    Set dic = CreateObject("Scripting.Dictionary")
    dic("p. cloudly") = "Partially cloudly"
    dic("clear") = "Clear sky"
    dic("cloudly") = "Cloudly"
    dic("rain") = "Rainy"
    
    For SheetCounter = 1 To ThisWorkbook.Sheets.Count
        Sheets(SheetCounter).Activate
        Set RngToClean = Range(Cells(4, 3), Cells(20, 11))
        With RngToClean
            For Each vKey In dic.keys
                .Replace What:=vKey, Replacement:=dic(vKey), LookAt:=xlWhole
            Next vKey
        End With
    Next SheetCounter

End Sub

I used a Dictionary object
See
https://excelmacromastery.com/vba-dictionary/

Hope this helps

M.

 

[Archangelos]

Hello my Brazilian friend. it's very very good. I will modify my code and come back again.