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

Chirolove

New Member
Joined
Jul 2, 2019
Messages
19
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.


Code:
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

New Member
Joined
Jul 2, 2019
Messages
19
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.
Code:
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
 

Some videos you may like

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
17,414
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,632
Messages
5,625,988
Members
416,149
Latest member
Bigpotato 668

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
Top