Insert "X" every certain number of columns after finding "X", based on value of cell in same row

[Chirolove]

Hello all,

I am trying to write VBA to do a specific task, and I am almost there. I simply need a little bit of help to figure out how to do the remaining actions.

Here is what I am trying to do with this code:
1) For rows 11 to 185, search range L11:DK185 for the cell value "X"
2) If "X" is found, insert another "X" in this same row ONLY (to the right), "Y" number of columns based on the value of that row's "J" column (Which is next to Day, in column "K")
3) Loop this and insert "X" every "Y" number of columns in this row until you reach column DK, where I no longer want X's afterwards
4) Repeat this for every row, individually.

For example, if I have the value "4" in column J of row 17, and an "X" in cell "AS17": I want to insert "X" every 4 columns to the right of this row, i.e place an "X" in cells AW17, AA17, etc.. until I reach DK17.

This is my code so far, but it is not functioning properly. It places the "X" all in row 11, rather than in the same row the searched "X" is found in, and it does not repeat the process until column "DK".

Thanks in advance for your help! Been breaking my head over this one for a while.

PS: I'm thinking the code should just be remade from scratch, I'm a super beginner at this and this code is probably not even the right way to look at the situation.

Sub InsertX()


    Application.ScreenUpdating = False
    Dim day As Range, fnd As Range, srcWS As Worksheet
    Set srcWS = Sheets("PLAN 2019")
    
    For Each day In srcWS.Range("K11:K185")
        Set fnd = srcWS.Range("L11:DK185").Find("X", LookIn:=xlValues, LookAt:=xlWhole)
        If Not fnd Is Nothing Then
            fnd.Offset(0, (day.Offset(0, -1).Value)).Value = "X" 'WOULD LIKE TO CHANGE THIS TO TAKE VALUE FROM COLUMN "J" OF ACTIVECELL'S ROW RATHER THAN DO SO BY OFFSET
        End If
    Next day
'INSERT LOOP HERE TO REDO UNTIL COLUMN DK
    Application.ScreenUpdating = True
    
End Sub

 

[Chirolove]

Hey JoeMo,

Yes, this is great! Does the job just as well as the other code, and ignores the errors present in my document. Worked like a charm!

Thank you for your help, and I'm sorry again for this big thread. I should have realized there were cells returning errors before seeking help for the code, although I am not the one who has made the original version of this workbook.

Thank you for taking the time, you've been a great help and I really do appreciate it Have a great day!

This will ignore the error cells, add the X's and replace all formula cells with either: (1) the value or error the cells were returning or (2) X if the cell is positioned to meet the spacing set by the col J value.

Sub chirolove()
Dim R As Range, Vin As Variant, Y As Variant, i As Long, j As Long, k As Long, Z As Variant
Const F As String = "X"
Set R = Range("L11:DK185")
Vin = R.Value
Y = Range("J11:J185").Value
For i = 1 To UBound(Vin, 1)
    For j = 1 To UBound(Vin, 2)
        If Not IsError(Vin(i, j)) Then
            If Vin(i, j) = F Then
                For k = j + Y(i, 1) To UBound(Vin, 2) Step Y(i, 1)
                    Vin(i, k) = F
                Next k
            End If
        End If
    Next j
Next i
R.Value = Vin
End Sub

 

[JoeMo]

Hey JoeMo,

Yes, this is great! Does the job just as well as the other code, and ignores the errors present in my document. Worked like a charm!

Thank you for your help, and I'm sorry again for this big thread. I should have realized there were cells returning errors before seeking help for the code, although I am not the one who has made the original version of this workbook.

Thank you for taking the time, you've been a great help and I really do appreciate it Have a great day!

You are welcome - thanks for the reply.