Select Case - To Reduce Repeating Code

[dj44]

folks,

good day can any one help me cut this down into more elgance looking its getting a bit long now i am getting confused with the long code

it basically searches the column and numbers the placeholder in each column -I am just repeating for each column

 Sub Number_Items()
    
    Dim lngIndex As Long: lngIndex = 1
    Dim lngIndex1 As Long: lngIndex = 1
    
    Dim oLastRow As Long, i As Long
    
   
    '------ Column D  : Category1
    oLastRow = Range("D" & Rows.Count).End(xlUp).Row
    
    For i = 9 To oLastRow
    
    With Range("D" & i)
    .Value = Replace(.Value, "DXX", lngIndex)     ' << Search and Replace here
    
    lngIndex = lngIndex + 1
    End With
    Next i
    
    
    
    '------ Column E  : Category2
    oLastRow = Range("E" & Rows.Count).End(xlUp).Row
    
    For i = 9 To oLastRow
    
    With Range("E" & i)
    .Value = Replace(.Value, "EXX", lngIndex)     ' << Search and Replace here
    
    lngIndex = lngIndex + 1
    End With
    Next i
    
    '-------- Column F : Name
    oLastRow = Range("F" & Rows.Count).End(xlUp).Row
    
    For i = 9 To oLastRow
    
    With Range("F" & i)
    .Value = Replace(.Value, "FXX", lngIndex1)     ' << Search and Replace here
    
    lngIndex1 = lngIndex1 + 1
    End With
    Next i
    
       '-------- Column G : ID
    oLastRow = Range("G" & Rows.Count).End(xlUp).Row
    
    For i = 9 To oLastRow
    
    With Range("G" & i)
    .Value = Replace(.Value, "GXX", lngIndex1)     ' << Search and Replace here
    
    lngIndex1 = lngIndex1 + 1
    End With
    Next i
    
         '-------- Column H : Notes
    oLastRow = Range("HXX" & Rows.Count).End(xlUp).Row
    
    For i = 9 To oLastRow
    
    With Range("H" & i)
    .Value = Replace(.Value, "&", lngIndex1)     ' << Search and Replace here
    
    lngIndex1 = lngIndex1 + 1
    End With
    Next i
    

    End Sub

may be a select case statement but i couldnt work out where to put the code and the rest of the code for the case range

thank you for any help

[Jan Karel Pieterse]

I think this should do it:

Sub Number_Items()
    Dim lngIndex As Long: lngIndex = 1
    Dim lngIndex1 As Long: lngIndex = 1
    Dim oLastRow As Long, i As Long
    Dim lCol As Long
    For lCol = 4 To 8
        oLastRow = Cells(Rows.Count, 4).End(xlUp).Row
        For i = 9 To oLastRow
            With Cells(i, lCol)
                .Value = Replace(.Value, "DXX", lngIndex)    ' << Search and Replace here
                lngIndex = lngIndex + 1
            End With
        Next i
    Next
End Sub

[dj44]

Hello Jan,

thank you for the loop

well my code does look very inefficent

its true each column has a different placeholder

DXX
EXX
FXX
GXX

so it was the above i was trying to number from 0 and increment DXX1,DXX2

EXX1,EXX2,EXX3
FXX1,FXX2, etc

now dont get me started on arrays i have a lot of problems with those always

Where shall i put the rest of my placeholders in the code becuase its now a 2 dimensional thing of some proportion

[Paul_Hossler]

I'd modularize and put the replace logic into a sub

Option Explicit
 
Sub Number_Items()
    Dim lngIndex As Long, lngIndex1 As Long
     
    lngIndex = 1
    lngIndex1 = 1
     
     
    Call pvtReplace("D", lngIndex)
    Call pvtReplace("E", lngIndex)
     
    Call pvtReplace("F", lngIndex1)
    Call pvtReplace("G", lngIndex1)
    Call pvtReplace("H", lngIndex1, "&")
     
End Sub

Private Sub pvtReplace(ColLetter As String, ByRef lngInx As Long, Optional ReplaceWith As String = vbNullString)
     Dim rowLast As Long, i As Long
     
    rowLast = Range(ColLetter & Rows.Count).End(xlUp).Row
     
    For i = 9 To rowLast
         
        With Range(ColLetter & i)
            If Len(ReplaceWith) = 0 Then
                .Value = Replace(.Value, ColLetter & "XX", lngInx) ' << Search and Replace here
             Else
                .Value = Replace(.Value, ColLetter & "XX", ReplaceWith) ' << Search and Replace here
            End If
             
            lngInx = lngInx + 1
        End With
    Next i
End Sub

[dj44]

Thank you Paul,

that looks so much better for me and so much more attractive on the eyes than trying to find the XX in my long code.

I put a bunch of placeholders in order in the Column - then i tried to number them and it numbered the wrong column

Then i had to copy and paste them all over again - set them up in the columns, so that was half my morning.


ok i can put all my columns on the top and this will sort them out nicely and number them now in order
so i dont have to accidently put the wrong xx in the wrong place in the wrong column
well excel keeps jumping horizontally so i blame excel for that one

Cheers for the great code Paul

thanks to Jan for the loop

and good thursday to all

[Paul_Hossler]

well excel keeps jumping horizontally so i blame excel for that one

If you mean after you hit the [Enter] key, you can change that

Capture.JPG

[dj44]

Excels been fiddling with my settings, please keep your hands off my excel Excel

Well it does have a mind of its own - i changed the settings one day and i never found the setting button again.

The button option vanished into thin air - or may be i was hallucinating for a non existant button

I also never knew that the personal workbook had a hidden worksheet - i was flabbergasted to discover it had always been there
i just had to unhide it

time for some new spectacles me thinks