Excel Macro Help

Hello,

I need some help with an excel macro. Have a .xls file with 10 columns, and over 7K rows. I need a macro to search a specific column (column 3) for the existance of the string "Solution :" If the cell contains the search string, I would like to cut the contents of the cell beginning at the "S" in "Solution" to the end of the cell and paste it in the same row, two columns over to the right. (Column 5)

I am very new to excel and VBA and don't even know where to start. Any example code would be helpful. Thanks in advance.

-John

John:

Break the task into several pieces and get familiar with each piece. Here is an example of searching for "Solution" in column 3. The "ActualUsedRange" function can be found in the following post: Need Help on selecting using vba on excel

Code:

---

Option Explicit
Sub Search_String()
  Dim aStr As String
  Dim aRange As Range
  Dim mySheet as Worksheet
  Dim aCell As Range
  Dim aRow As Long
  Dim aCol As Long
  Dim i As Long
 
  'Initialize the search string
  aStr = "Solution"
 
  'What sheet are we working on?
  '(Edited!)
  Set mySheet = ActiveSheet  ' -or-  Sheets("mySheetName")

  aRow = 2  'Skips over headers in row 1
  aCol = 3  'Initialize the search column
 
  'Find the Real UsedRange for the data
  Set aRange = ActualUsedRange(mySheet)
  If aRange = Nothing Then
      MsgBox "This Sheet is EMPTY!" : Exit Sub
  End If
  For i = aRow To aRange.Rows.Count
      If Cells(aRow, aCol).Value = aStr Then
          ' Put code to process "Solution" Found HERE
          'TEST TEST TEST TEST
          MsgBox "FOUND: " & Cells(aRow, aCol).Address & Chr(10) & Cells(aRow, aCol).Value
          'END TEST
      Else
          'TEST TEST TEST TEST
          MsgBox "Not Found: " & Cells(aRow, aCol).Address & Chr(10) & Cells(aRow, aCol).Value
          'END TEST
          ' Put code to process NOT FOUND Here
      End If
      aRow = aRow + 1
  Next i
 
End Sub

---

Good Learning and Good Programming!

This shoud work

VB Code:

Sub FindSolution()
Dim MySheet As Worksheet
Dim RowCount As Integer
Dim SearchValue As String
Dim MyRow As Integer
Dim MyCell As Range
Dim StartNum As Integer
 
    Set MySheet = Sheets("Sheet1") 'Set this variable to the worksheet that has your data
    RowCount = MySheet.UsedRange.Rows.Count 'Find how many rows are used on the sheet
    SearchValue = "Solution :" 'This is the value you are searching for
    
    For MyRow = MySheet.UsedRange.Row To MySheet.UsedRange.Row + RowCount - 1 'loop through each row in the used range
        Set MyCell = MySheet.Cells(MyRow, 3) 'set this variable to the cell in the third colum
        StartNum = InStr(1, MyCell, SearchValue, vbTextCompare) 'find the starting position of the search value in the searched cell
        If StartNum > 0 Then ' if the starting position is not zero then the value is in the cell
            MyCell.Offset(0, 2) = Mid(MyCell, StartNum) 'copy the text from the searched cell to the cell 2 columns to the right, starting with the search string
        End If
    Next MyRow
    
    Set MyCell = Nothing 'clear your object variables
    Set MySheet = Nothing 'clear your object variables
End Sub

Thanks Art and Declan,

Declan, your solution worked great. One quick question regarding Declan's solution, instead of copying the selected text, can it be cut, so it no longer appears in column 3.

You can always test small things by recording a macro, doing the little tasks, stopping the macro, and then edit the macro to look at the code that was produced. Use this code as a template to insert into your actual code.

I've added a line to replace the value in column 3.

VB Code:

Sub FindSolution()
Dim MySheet As Worksheet
Dim RowCount As Integer
Dim SearchValue As String
Dim MyRow As Integer
Dim MyCell As Range
Dim StartNum As Integer
 
    Set MySheet = Sheets("Sheet1") 'Set this variable to the worksheet that has your data
    RowCount = MySheet.UsedRange.Rows.Count 'Find how many rows are used on the sheet
    SearchValue = "Solution :" 'This is the value you are searching for
    
    For MyRow = MySheet.UsedRange.Row To MySheet.UsedRange.Row + RowCount - 1 'loop through each row in the used range
        Set MyCell = MySheet.Cells(MyRow, 3) 'set this variable to the cell in the third colum
        StartNum = InStr(1, MyCell, SearchValue, vbTextCompare) 'find the starting position of the search value in the searched cell
        If StartNum > 0 Then ' if the starting position is not zero then the value is in the cell
            MyCell.Offset(0, 2) = Mid(MyCell, StartNum) 'copy the text from the searched cell to the cell 2 columns to the right, starting with the search string
            MyCell = Application.WorksheetFunction.Replace(MyCell, StartNum, Len(MyCell.Offset(0, 2)), "")
        End If
    Next MyRow
    
    Set MyCell = Nothing 'clear your object variables
    Set MySheet = Nothing 'clear your object variables
End Sub