extract a row within a cell based on keyword

Hi all,

i am wondering if there is any way to extract a row of data within a cell?currently, in the "atm withdrawl" sheet, i have created a macro to copy cells in other sheets ( jan to dec) with the word "atm" into the sheet. However, i would like the program to extract the row with the word "atm" instead of the whole cell. is there any way to do so?Thanks.

Regards,
Dan

Try this modified version of your code

Sub atm()

    Range("a6:l300").ClearContents
    m = 6
    For n = 1 To 12    ' months
        For a = 6 To 36    ' range of each sheet
            '  For j = 2 To 5 ' time slot
            If Sheets(n).Cells(a, 2).Value Like "*atm*" Then
                Sheets(14).Cells(m, n).Value = "Date: " & Sheets(n).Cells(a, 1) & Chr(10) & Mid(Sheets(n).Cells(a, 2), InStr(Sheets(n).Cells(a, 2), "atm"))
                m = m + 1
            End If
        Next
    Next

End Sub

Hope this helps

This will extract the atm part of the cell assuming it will be the last entry of the day
Change activecell to the cell you are using in your loop
Str is the part you will be sending to the other sheet

    Dim CntSt As Integer, MyPos, Str As String

    CntSt = Len(ActiveCell)
    MyPos = InStr(1, ActiveCell, "atm")
    If MyPos > 0 Then
        Str = Mid(ActiveCell, MyPos, CntSt)
        MsgBox Str
    End If

As an extra to your question you might want to use this instead of the rather lengthy code you are using at present

Sub Next_year()
    Dim DaysInMonth As Integer, wsNo As Integer
    Dim YearToSet As String, ChkFileName

    ThisWorkbook.Save
    ActiveWorkbook.Application.ScreenUpdating = False

    YearToSet = InputBox("Enter the year to use.", "New File", Year(Now()))

    For wsNo = 1 To Sheets.Count
        On Error Resume Next
        ChkFileName = CDate("1/" & Sheets(wsNo).Name & "/" & YearToSet)
        If Err.Number <> 0 Then
            Err.Clear
        Else
            With Sheets(wsNo)
                If .Name = "December" Then
                    DaysInMonth = CDate("1/January/" & YearToSet + 1) - CDate("1/" & .Name & "/" & YearToSet)
                Else
                    DaysInMonth = CDate("1/" & Month(CDate("1/" & .Name & "/" & YearToSet)) + 1 & "/" & YearToSet) _
                                  - CDate("1/" & .Name & "/" & YearToSet)
                End If
                .Range("a6:f36").ClearContents                      'converts cells from "a6 to f36" to empty cells
                .Range("a6:f36").Interior.ColorIndex = xlNone       ' remove background colour

                .Range("A6") = CDate("1/" & .Name & "/" & YearToSet)
                .Range("A6:A" & DaysInMonth + 5).DataSeries Rowcol:=xlColumns, Type:=xlChronological, _
                                                            Date:=xlDay, Step:=1, Trend:=False
                .Range("A6:A" & DaysInMonth + 5).NumberFormat = "dd (ddd)"
            End With
        End If
        On Error GoTo 0
    Next

    ActiveWorkbook.Application.ScreenUpdating = True

    ThisWorkbook.SaveAs (ThisWorkbook.Path & "\" & "My spendings " & Year(Date) + 1)    'current year + 1

End Sub

Both suggestions are in this attachment.

I haven't tried Daves' code, just adapted yours.

Why would you put all entries into one cell?
You can't do anything with them, each entry needs to be in a separate cell.

Merged cells are not a good thing to have either.

Try this example of creating a new workbook for the new year.
It uses a helper sheet to reduce the amount of code required and is less confusing.

It will save as a new workbook and then delete the helper sheet.

Something to work on anyway...

1/. This will handle "atm" in any row

Sub atm()
    Dim strATM As String
    Dim a As Long, m As Long
    
    Range("a6:l300").ClearContents
    m = 6
    For n = 1 To 12    ' months
        For a = 6 To 36    ' range of each sheet
            If Sheets(n).Cells(a, 2).Value Like "*atm*" Then
                strATM = Mid(Sheets(n).Cells(a, 2), InStr(Sheets(n).Cells(a, 2), "atm"))
                If InStr(1, strATM, Chr(10)) > 0 Then
                    strATM = Left(strATM, InStr(1, strATM, Chr(10)) - 1)
                End If
                Sheets(14).Cells(m, n).Value = "Date: " & Sheets(n).Cells(a, 1) & Chr(10) & strATM
                m = m + 1
            End If
        Next
    Next

End Sub

2/. Doesn't the workbook I posted work for you?
It seems okay to me.
I just tested the uploaded file in case I had posted the workbook without saving the final version, and it seems to work.

3/. This code

DaysInMonth = CDate("1/January/" & YearToSet + 1) - CDate("1/" & .Name & "/" & YearToSet)

Is used to calculate the number of days in the month of December, as this never varies I could have just used

DaysInMonth = 31

I left it in to let you see why it is different from all the other months in this instance.

DaysInMonth = CDate("1/" & Month(CDate("1/" & .Name & "/" & YearToSet)) + 1 & "/" & YearToSet) - CDate("1/" & .Name & "/" & YearToSet)

CDate("1/" & .Name & "/" & YearToSet)

".Name" returns the sheet name (It is contained within the With Statement)
"YearToSet" is returned from the Input box.
When this is concatenated we get
e.g.
"1/January/2010" as a string

Cdate("1/January/2010")

returns a date

CDate("1/" & Month(CDate("1/" & .Name & "/" & YearToSet)) + 1 & "/" & YearToSet)

Month(CDate("1/" & .Name & "/" & YearToSet)) + 1

This returns the next month based on the name of your worksheet.

We then subtract the two to get the number of days in any month.

Hope this helps

Surely you mean

DaysInMonth = CDate(Month(CDate("1/" & .Name & "/" & YearToSet)) + 1 & "/" &  "1/" & YearToSet) _
                                  - CDate(.Name & "/" & "1/" & YearToSet)

both parts of the formula should have the same format structure.

1/. The dates issue must be due to your computers' Regional Settings, if it now works then all is well, the expanation I gave earlier still stands.

2/. Try this

Sub atm()
    Dim strItem As String
    Dim Keyword As String
    Dim a As Long, m As Long
    
    Keyword = InputBox("Enter String to Find (Lower Case)", "Extract String", "atm")
    
    Range("a6:l300").ClearContents
    m = 6
    For n = 1 To 12    ' months
        For a = 6 To 36    ' range of each sheet
            If Sheets(n).Cells(a, 2).Value Like "*" & Keyword & "*" Then
                strItem = Mid(Sheets(n).Cells(a, 2), InStr(Sheets(n).Cells(a, 2), Keyword))
                If InStr(1, strItem, Chr(10)) > 0 Then
                    strItem = Left(strItem, InStr(1, strItem, Chr(10)) - 1)
                End If
                Sheets(14).Cells(m, n).Value = "Date: " & Sheets(n).Cells(a, 1) & Chr(10) & strItem
                m = m + 1
            End If
        Next
    Next

End Sub

I have changed the variable names to be more descriptive of the new problem, I suggest you also change the sub name, and assisn the renamed macro to the relevant button.

Note this method is case sensitive, but that would not appear to be a problem as all your data is in lower case.

Hope this helps.

Oh i see. so that is how to use the wild card. thanks for all the help. 1 more question, hopefully the last, what if the keyword has both upper and lower case? this is for the other program i am using.

Try this

Sub atm()
    Dim strItem As String
    Dim Keyword As String
    Dim a As Long, m As Long
    
    Keyword = InputBox("Enter String to Find", "Extract String", "ATM")
    Keyword = LCase(Keyword)
    
    Range("a6:l300").ClearContents
    m = 6
    For n = 1 To 12    ' months
        For a = 6 To 36    ' range of each sheet
            If LCase(Sheets(n).Cells(a, 2).Value) Like "*" & Keyword & "*" Then
                strItem = LCase(Sheets(n).Cells(a, 2).Value)
                strItem = Mid(strItem, InStr(strItem, Keyword))
                If InStr(1, strItem, Chr(10)) > 0 Then
                    strItem = Left(strItem, InStr(1, strItem, Chr(10)) - 1)
                End If
                Sheets(14).Cells(m, n).Value = "Date: " & Sheets(n).Cells(a, 1) & Chr(10) & strItem
                m = m + 1
            End If
        Next
    Next

End Sub

This will return the result in lower case (for the search string)

If you want the result in upper case then change this line

Sheets(14).Cells(m, n).Value = "Date: " & Sheets(n).Cells(a, 1) & Chr(10) & strItem

to

Sheets(14).Cells(m, n).Value = "Date: " & Sheets(n).Cells(a, 1) & Chr(10) & Ucase(strItem)

If you want proper case you will need to use WorksheetFunction.Proper()

Sheets(14).Cells(m, n).Value = "Date: " & Sheets(n).Cells(a, 1) & Chr(10) & WorksheetFunction.Proper(strItem)

Hope this helps