VBA find select all then shift all adjacent cells to the right - vba

Question

I'm trying to write a macro that will sort a work book that is generated by a system at work. I have attempted to chopshop some code together from other posts on this site with no success.
The goal is to search column A for any cells that contain either "IN" or "OUT" then move every thing to the right of these cells one cell to the right.
I have some code that works for the first output but it will only ever ready the first out put I know why it doesn't work but I don't know how to fix it.
Any help would be much appreciated,
Thanks,
Sub Data_only()
'
' Reworks_Data_only Macro
'
' Keyboard Shortcut: Ctrl+k
'
Columns("J:AB").Select
Selection.ClearContents
Cells.Select
Cells.EntireColumn.AutoFit`enter code here`
' ^ Cuts out unused columns and autofits the rest
Columns("A:A").Select
Selection.Find(What:="in", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
' ^Searches Column A for "IN"
ActiveCell.Offset(, 1).Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
' ^Selects the found cell and shift the whole row to the right
End Sub
EDIT
This is a mock up of the file im looking to change, there would normally be a few hundred batches and a lot more columns but it should be workable.
batches mock up

Answer 1

Something like that would be possible if you like to use the Find function ...
Option Explicit
Public Sub Data_only()
MoveByFind "IN"
MoveByFind "OUT"
End Sub
Public Function MoveByFind(FindString As String)
Dim Found As Range
Set Found = Columns("A:A").Find(What:=FindString, LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not Found Is Nothing Then
Dim firstAddress As String
firstAddress = Found.Address 'remember first find for no endless loop
Do
Found.Offset(0, 1).Insert Shift:=xlToRight 'move cells right
Set Found = Columns("A:A").FindNext(After:=Found) 'find next
Loop While Not Found Is Nothing And Found.Address <> firstAddress 'loop until end or nothing found
End If
End Function

Answer 2

You can do this with a simple loop, rather than using the Find function:
Dim i as Long, LR as Long
LR = Cells(Rows.Count,1).End(xlUp).Row
For i = 2 to LR 'Assumes you have a header in row 1
If Cells(i,1).Value = "IN" OR Cells(i,1).Value = "OUT" Then
Cells(i,2).Insert Shift:=xlToRight
End If
Next i
Note that In and Out are case-sensitive.
You could also do this with the Find function, though you would find all, or use find next, and use the .insert as you've doen in your code.
Edit:
Assuming that the issue is hidden characters, InStr can be used:
Dim i As Long, LR As Long, j As Integer, k As Integer
LR = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LR 'Assumes you have a header in row 1
j = InStr(Cells(i, 1).Value, "IN")
k = InStr(Cells(i, 1).Value, "OUT")
If j > 0 Or k > 0 Then
Cells(i, 2).Insert Shift:=xlToRight
End If
Next i