PDA

View Full Version : Loop through, comparing string question



huaya
11-08-2007, 10:41 AM
Hello,

I am encountering a loop through problem in a big data set in Excel. I am trying to loop through a column in Sheet1, as long as the column contain a specified word which defined in a column in Sheet2, the next column same row in sheet2 will appear in the same row of next column in Sheet1.

The simplified example as follows:

Table 1 in Sheet1:

Column A Column B
1 SP 100000
2 PO 100000
3 IO 100000
4 INV 100000

A big data in Sheet2:

Column A Column B
1 FIX 1000
2 FIX 1000
3 FIX/IO 1000
4 INV/IO 1000
5 FLT 1000
6 FLT 1000
7 FLT/DLY/SP 1000
8 PO 1000
9 FIX 1000
10 FIX 1000
11 FIX/Z 1000
12 INV 1000

I want to match the word in column A of sheet1 with column A in sheet2. If it matches, the same row of Column B in sheet2 will be same as column B in sheet1.

For example, "A1"in sheet1 is "SP", "A7" in column A of sheet2 also contains "SP", so "B7" in sheet2 will be 100000. The revised data set should be same as below. Can anyone help me with to create a VBA code to perform it. I have tried compare string method, but since the word in sheet1 column A is in the middle cell of of column A of sheet2 , I do not know how to create it.

Column A Column B
1 FIX 1000
2 FIX 1000
3 FIX/IO 100000
4 INV/IO 100000
5 FLT 1000
6 FLT 1000
7 FLT/DLY/SP 100000
8 PO 100000
9 FIX 1000
10 FIX 1000
11 FIX/Z 1000
12 INV 100000

figment
11-08-2007, 12:09 PM
might not be the most eficent code but try this

Sub Testing()
Dim a As Integer, b As Integer
a = 1
While Worksheets("Sheet1").Range("A" & a) <> ""
b = 1
While Worksheets("Sheet2").Range("A" & b) <> ""
If compare("Sheet1", "A" & a, "Sheet2", "A" & b) Then
Worksheets("Sheet2").Range("B" & b) = Worksheets("Sheet1").Range("B" & a)
End If
b = b + 1
Wend
a = a + 1
Wend
End Sub

Function compare(s1 As String, r1 As String, s2 As String, r2 As String)
Dim a As Long, b As Long, c As Long
a = Len(Worksheets(s1).Range(r1))
b = Len(Worksheets(s2).Range(r2))
c = 1
For c = 1 To b - a + 1
If Mid(Worksheets(s2).Range(r2), c, a) = Worksheets(s1).Range(r1) Then
compare = True
Exit Function
End If
Next
End Function

huaya
11-08-2007, 04:46 PM
The code works perfectly.

Thanks again :hi: