CODEWITHSUNDEEP
vbaexcel
salm
salm

Reputation: 27

VBA search and copy

I'm automating an update I have to do and part of the macro I want to write needs specific text from what gets populated. I have the following types of text in the same column for hundreds of rows:

ScreenRecording^naushi02^procr^10035

procr^10635^ScreenRecording^misby01

ScreenRecording^liw03^procr^10046

I've bold the text I need. I want to either replace the whole text with just what I need or place what I need in the next column, same row.

I had wrote something which worked for 60 or so lines before I realised that there are variations in the format. For the main, it's all the same which is why I didn't realise at first and I've spent a lot of wasted time writing something that is now useless... so I'm asking for expert help please.

Once I've got what I need from the first row, I need to move down until the last entry repeating.

I had some code which obviously didn't work fully.

I have thought about using the text 'ScreenRecording' in a search along with the special character which I can't find on my keyboard and then trying to copy all text from that point upto and including the 2nd numerical character. I don't know how to do this, if it would work or even if it's a good idea but because I've spent so much time trying to figure it out, I need some help please.

Thanks in advance

Upvotes: 0

Views: 65

Answers (2)

user3598756
user3598756

Reputation: 29421

if you want to replace:

Sub main2()
    Dim key As String
    Dim replacementStrng As String

    key = "ScreenRecording"
    replacementStrng = "AAA"
    With Worksheets("mysheet01").columns("A") '<--| change "mysheet01" and "A" to your actual sheet name and column to filter
        .Replace what:=key & "^*^", replacement:=key & "^" & replacementStrng & " ^ ", LookAt:=xlPart
        .Replace what:="^" & key & "^*", replacement:="^" & key & "^" & replacementStrng, LookAt:=xlPart
    End With
End Sub

while if you want to place what you need in the next column:

Sub main()
    Dim myRng As Range

    Set myRng = GetRange(Worksheets("mysheet01").columns("A"), "ScreenRecording^") '<--| change "mysheet01" and "A" to your actual sheet name and column to filter
    myRng.Offset(, 1) = "value that I need to place in next row" '<--| change the right part of the assignment to what you need
End Sub

Function GetRange(rng As Range, key As String) As Range
    With rng
        .AutoFilter Field:=1, Criteria1:="*" & key & "*" '<--| apply current filtering
        If Application.WorksheetFunction.Subtotal(103, .Cells) > 0 Then '<--| if there are visible cells other than the "header" one
            With .SpecialCells(xlCellTypeConstants)
                If InStr(.SpecialCells(xlCellTypeVisible).Cells(1, 1), key  & "^") > 0 Then
                    Set GetRange = .SpecialCells(xlCellTypeVisible) '<--|select all visible cells
                Else
                    Set GetRange = .Resize(.Parent.Cells(.Parent.Rows.Count, .Column).End(xlUp).row - 1).Offset(1).SpecialCells(xlCellTypeVisible) '<--|select visible rows other than the first ("headers") one
                End If
            End With
        End If
        .Parent.AutoFilterMode = False '<--| remove drop-down arrows
    End With
End Function

Upvotes: 0

basodre
basodre

Reputation: 5770

If you always want to return the value after the word 'ScreenRecording`, you can use the following function to do so.

Include it in a SubRoutine to replace in place if needed:

Function SplitScreenRecording(sInput As String) As String
    Dim a As Variant

    Const SDELIM As String = "^"
    Const LOOKUP_VAL As String = "ScreenRecording"

    a = Split(sInput, SDELIM)

    If IsError(Application.Match(LOOKUP_VAL, a, 0)) Then
        SplitScreenRecording = CVErr(2042)
    Else
        SplitScreenRecording = a(Application.Match(LOOKUP_VAL, a, 0))
    End If
End Function

Sub ReplaceInPlace()
    Dim rReplace As Range
    Dim rng As Range

    Set rReplace = Range("A1:A3")

    For Each rng In rReplace
        rng.Value = SplitScreenRecording(rng.Value)
    Next rng
End Sub

Upvotes: 2

Related Questions