Help using InStr? Referencing a different sheet.

[Coyotex3]

Hi Again, hoping someone can help me figure this one out.

On Sheet 1 I have the following:

Book2
	A	B	C
1	Account Type	Notes	Total
2	Outstanding	100 105	3,500.00
3	Outstanding	330 345	7,000.00
4	Outstanding	200 205	8,950.00
5	Outstanding	550 550	4,650.00
Sheet1

On Sheet 2 I have the following:

Book2
	A	B
1	Description	Amount
2	Account 100 105
3	Vehicles
4
5	Acc. 200 205
6	Boats
7
8
9	Acct 330 345
10	Planes
11
12
13	Acc 450 550
14	Trains
Sheet2

I've been working on this code

Dim WB1 As Workbook, WS1 As Worksheet, WS2 As Worksheet
Set WB1 = ThisWorkbook
Set WS1 = WB1.Worksheets("Sheet1")
Set WS2 = WB1.Worksheets("Sheet2")
For Each c1 In WS2.Range("A2", Range("A" & Rows.Count).End(xlUp))
    If InStr(1, c1.Value, "100 105") > 0 Then c1.Offset.End(xlToLeft).Offset(, 1).Value = WS1.Range("C2").Value2
    If InStr(1, c1.Value, "200 205") > 0 Then c1.Offset.End(xlToLeft).Offset(, 1).Value = WS1.Range("C3").Value2
    If InStr(1, c1.Value, "330 345") > 0 Then c1.Offset.End(xlToLeft).Offset(, 1).Value = WS1.Range("C4").Value2
    If InStr(1, c1.Value, "450 550") > 0 Then c1.Offset.End(xlToLeft).Offset(, 1).Value = WS1.Range("C5").Value2
Next
End Sub

To get to this:

Book2
	A	B
1	Description	Amount
2	Account 100 105	3500
3	Vehicles
4
5	Acc. 200 205	7000
6	Boats
7
8
9	Acct 330 345	8950
10	Planes
11
12
13	Acc 450 550	4650
14	Trains
Sheet2

My issue is that "Sheet1" Column "B" might not always be in that order. I would like for the code to compare "Sheet1" Column "A" and Sheet2 Column "B", and if there is a match, give me the desired output from Column "C".

Note: This Code isn't complete. Cell B13 should be left empty in the final outcome since Sheet2 Cell A13 does not match any of the notes on Sheet1 Column B. Also, Cellls B5 & B9 have the wrong amounts. Cell B5 should have 8950 and Cell B9 should have 7000. I have not been able to figure out how to expand on this.

Hope this makes sense.

Thank you.

 

[James006]

Hi,

With the exception of cell A2, do you have a constant step of 4 in between in the "Acct xxx xxx" cells with consistently the right 7 characters representing your account number

 

[veyselemre]

Hi, try this..

Sub test()
    Dim lst, rng As Range, i, dic As Object, acc

    With Worksheets("Sheet1")
        lst = .Range("B2:C" & .Cells(Rows.Count, 2).End(3).Row).Value
    End With

    Set dic = CreateObject("Scripting.Dictionary")

    For i = 1 To UBound(lst)
        dic.Item(lst(i, 1)) = lst(i, 2)
    Next i

    With Worksheets("Sheet2")
        Set rng = .Range("A2:B" & .Cells(Rows.Count, 1).End(3).Row)
    End With

    With CreateObject("VbScript.Regexp")
        .Pattern = "[A.]*([\d]{3}\s[\d]{3})"
        For i = 1 To rng.Rows.Count
            If .test(rng.Cells(i, 1).Value) Then
                acc = .Execute(rng.Cells(i, 1).Value)(0)
                If dic.exists(acc) Then rng.Cells(i, 2).Value = dic(acc)
            End If
        Next i
    End With
End Sub

 

[Coyotex3]

Hi,

With the exception of cell A2, do you have a constant step of 4 in between in the "Acct xxx xxx" cells with consistently the right 7 characters representing your account number

Hi James, from what I observed there doesn't seem to be a pattern before the account number, but the account number itself will always follow the same pattern.

 

[Coyotex3]

Hi, try this..

Sub test()
    Dim lst, rng As Range, i, dic As Object, acc

    With Worksheets("Sheet1")
        lst = .Range("B2:C" & .Cells(Rows.Count, 2).End(3).Row).Value
    End With

    Set dic = CreateObject("Scripting.Dictionary")

    For i = 1 To UBound(lst)
        dic.Item(lst(i, 1)) = lst(i, 2)
    Next i

    With Worksheets("Sheet2")
        Set rng = .Range("A2:B" & .Cells(Rows.Count, 1).End(3).Row)
    End With

    With CreateObject("VbScript.Regexp")
        .Pattern = "[A.]*([\d]{3}\s[\d]{3})"
        For i = 1 To rng.Rows.Count
            If .test(rng.Cells(i, 1).Value) Then
                acc = .Execute(rng.Cells(i, 1).Value)(0)
                If dic.exists(acc) Then rng.Cells(i, 2).Value = dic(acc)
            End If
        Next i
    End With
End Sub

Thank you so much! This works!

If the pattern changes, do I just change this line?

.Pattern = "[A.]*([\d]{3}\s[\d]{3})"