Looping through cells

[peppe1985]

Hello,
i am new to VBA and i am trying to use the MID function in VBA to pull a string within a string and have it pasted to another work sheet. I have managed to get it working for 1 row across the various columns noted in code. What I am trying to do is have the code loop through a series of rows on my Sheet2 withing my workbook and pasting it in the Sheet 1. Any help or guidance will be greatly appreciated.

This is what i have so far.

Sub Button9_Click()

Dim pos_first As Integer
Dim pos_second As Integer
Dim Result_string As String
Dim Last_First1 As Integer
Dim Last_First2 As Integer
Dim First_First As Integer
Dim main_text As String
Dim search_text As String
Dim CRTID As Integer
Dim CRTID2 As Integer
Dim DOB As String

On Error Resume Next
Range("a6:a257").Select
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

main_text = worksheets("Docket").Cells(7, 1).Value 'CRT ID

search_text = ""

CRTID2 = InStr(2, main_text, search_text)

Result_string = Mid(main_text, CRTID2 + 8)

main_text = worksheets("Sheet2").Cells(7, 1).Value 'CRT ID

search_text = ""

CRTID = InStr(CRTID + 1, main_text, search_text)

Result_string = Mid(main_text, CRTID + 0, CRTID + CRTID2 + 1)

worksheets("Sheet1").Range("A7").Value = Result_string




main_text = worksheets("Sheet2").Cells(7, 1).Value 'Info Number

search_text = ""

pos_first = InStr(1, main_text, search_text)

pos_second = InStr(5, main_text, search_text)

Result_string = Mid(main_text, pos_first - pos_second + 13)

worksheets("Sheet1").Range("b7").Value = Result_string




main_text = worksheets("Sheet2").Cells(7, 4).Value 'First Name

search_text = ""

First_First = InStr(1, main_text, search_text)

Result_string = Mid(main_text, first_First1 + 7)

worksheets("Sheet1").Range("i7").Value = Result_string





main_text = worksheets("Sheet2 ").Cells(7, 4).Value 'Last Name

search_text = ""

Last_First1 = InStr(1, main_text, search_text)

Result_string = Mid(main_text, Last_First1 + 8)


main_text = worksheets("Sheet2").Cells(7, 4).Value 'Last Name

search_text = ""

Last_First2 = InStr(Last_First1 + 1, main_text, search_text)

Result_string = Mid(main_text, Last_First2 - 1, Last_First1 + Last_First2 + 4)


worksheets("Sheet1").Range("h7").Value = Result_string




main_text = worksheets("Sheet2").Cells(7, 5).Value 'DOB

search_text = ""

DOB = InStr(1, main_text, search_text)

Result_string = Mid(main_text, DOB + 1)

worksheets("Sheet1").Range("j7").Value = Result_string




End Sub

 

[johnnyL]

I think the code you posted can be reduced to:

Sub Button9_Click()
'
    Dim CRTID           As Long, CRTID2         As Long
    Dim First_First     As Integer
    Dim Last_First1     As Long, Last_First2    As Long
    Dim pos_first       As Long, pos_second     As Long
    Dim DOB             As String
    Dim main_text       As String
    Dim Result_string   As String
    Dim search_text     As String
'
    On Error Resume Next
    Range("A6:A257").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'
    search_text = ""
'
    main_text = Worksheets("Docket").Cells(7, 1).Value                  'CRT ID
    CRTID2 = InStr(2, main_text, search_text)
'
    main_text = Worksheets("Sheet2").Cells(7, 1).Value                  'CRT ID
    CRTID = InStr(CRTID + 1, main_text, search_text)
    Result_string = Mid(main_text, CRTID + 0, CRTID + CRTID2 + 1)
    Worksheets("Sheet1").Range("A7").Value = Result_string
'
    pos_first = InStr(1, main_text, search_text)
    pos_second = InStr(5, main_text, search_text)
    Result_string = Mid(main_text, pos_first - pos_second + 13)
    Worksheets("Sheet1").Range("b7").Value = Result_string
'
    main_text = Worksheets("Sheet2").Cells(7, 4).Value                  'First Name
    First_First = InStr(1, main_text, search_text)
    Result_string = Mid(main_text, first_First1 + 7)
    Worksheets("Sheet1").Range("i7").Value = Result_string
'
    Last_First1 = InStr(1, main_text, search_text)
    Last_First2 = InStr(Last_First1 + 1, main_text, search_text)
    Result_string = Mid(main_text, Last_First2 - 1, Last_First1 + Last_First2 + 4)
    Worksheets("Sheet1").Range("h7").Value = Result_string
'
    main_text = Worksheets("Sheet2").Cells(7, 5).Value                  'DOB
    DOB = InStr(1, main_text, search_text)
    Result_string = Mid(main_text, DOB + 1)
    Worksheets("Sheet1").Range("j7").Value = Result_string
End Sub

After that you might want to supply some date that we can test with.

 

[peppe1985]

Thanks Johnny. This was helpful and works great . I was able to figure out the looping as well. Thanks again for your help

 

[johnnyL]

Glad to help.