Copying rows based on four digits and finding a match

N

Nic Daniels

Hi,


I'm wondering if it would be possible to automatically copy rows based on
four digits in a file name from two sheets into one main sheet.


Ex

sheet1

List of files:

14.08.2006 15:28 ucr0001sh3-3.pdf
29.01.2007 14:39 ucP0003_13-4.pdf
26.09.2006 12:47 99ucm0008-1.pdf
06.10.2006 15:38 99m0008 rev1 com.pdf
06.10.2006 10:13 99m0008_1-1.pdf


sheet2:

9.9.M-0008 2 Steel Structure / Platforms for Aeration System (1)





9.9.M-0010 2 Steel Structure / Platforms for Aeration System (2)



So, the four ID-digits are found in column C in sheet1 and column A in sheet2.

The four digits are not always in the same position as you can see in column
A in sheet1, but they are always together as a unit.

In the third sheet, sheet3, the result would be something like this:

14.08.2006 15:28 ucr0001sh3-3.pdf
29.01.2007 14:39 ucP0003_13-4.pdf
26.09.2006 12:47 99ucm0008-1.pdf 9.9.M-0008 2 Steel Structure...
06.10.2006 15:38 99m0008 rev1 com.pdf
06.10.2006 10:13 99m0008_1-1.pdf

Sheet1 and sheet2 have now been matched.
If there are several files with the same four digits in sheet1, the
information from sheet2 should be put next to the first file with that unique
ID (as shown above), not all files with that specific ID-number.

I hope there is a solution to this...
 
J

Joel

I didn't look closely. This is a new request. Here is the new solution

Sub CombineSheets()

'Copy sheet 1 to sheet 3
Sheets("Sheet1").Cells.Copy _
Destination:=Sheets("Sheet3").Cells

'Put 4 digit number in column IV
With Sheets("Sheet3")
'put 4 digit numbers in column IV
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 1 To LastRow
MyStr = .Range("C" & RowCount)
For CharCount = 1 To (Len(MyStr) - 3)
ThisChar = Mid(MyStr, CharCount, 1)
NextChar = Mid(MyStr, CharCount + 1, 1)
NextCharPlus1 = Mid(MyStr, CharCount + 2, 1)
NextCharPlus2 = Mid(MyStr, CharCount + 3, 1)
If IsNumeric(ThisChar) And _
IsNumeric(NextChar) And _
IsNumeric(NextCharPlus1) And _
IsNumeric(NextCharPlus2) Then

Number = Mid(MyStr, CharCount, 4)
.Range("IV" & RowCount) = Number
Exit For
End If
Next CharCount
Next RowCount
End With

'get number in sheet 2 column A
With Sheets("Sheet2")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 1 To LastRow
MyStr = .Range("A" & RowCount)
For CharCount = 1 To (Len(MyStr) - 3)
ThisChar = Mid(MyStr, CharCount, 1)
NextChar = Mid(MyStr, CharCount + 1, 1)
NextCharPlus1 = Mid(MyStr, CharCount + 2, 1)
NextCharPlus2 = Mid(MyStr, CharCount + 3, 1)
If IsNumeric(ThisChar) And _
IsNumeric(NextChar) And _
IsNumeric(NextCharPlus1) And _
IsNumeric(NextCharPlus2) Then

Number = Mid(MyStr, CharCount, 4)
Exit For
End If
Next CharCount

Quant = .Range("B" & RowCount)
Description = .Range("C" & RowCount)

'search for number in sheet 3
With Sheets("Sheet3")
Set c = .Columns("IV").Find(what:=Number, _
LookIn:=xlValues, lookat:=xlWhole)

If Not c Is Nothing Then
Range("D" & c.Row) = Quant
Range("E" & c.Row) = Description
End If
End With

Next RowCount


End With

Sheets("Sheet3").Columns("IV").Delete

End Sub
 
N

Nic Daniels

Thank you for trying! Unfortunately, I cannot get this code to work. Sheet3
became just a copy of sheet1, the matching information in sheet2 is not being
copied into sheet3 as it should.

What could be wrong?
 
J

Joel

It is writing the data to the wrong sheet. I left out the periods on sheet 3
writes

from
If Not c Is Nothing Then
Range("D" & c.Row) = Quant
Range("E" & c.Row) = Description
End If
to
If Not c Is Nothing Then
.Range("D" & c.Row) = Quant
.Range("E" & c.Row) = Description
End If
 
N

Nic Daniels

It still does not work.

Your new code is:

Sub CombineSheetsNew()

'Copy sheet 1 to sheet 3
Sheets("Sheet1").Cells.Copy _
Destination:=Sheets("Sheet3").Cells

'Put 4 digit number in column IV
With Sheets("Sheet3")
'put 4 digit numbers in column IV
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 1 To LastRow
MyStr = .Range("C" & RowCount)
For CharCount = 1 To (Len(MyStr) - 3)
ThisChar = Mid(MyStr, CharCount, 1)
NextChar = Mid(MyStr, CharCount + 1, 1)
NextCharPlus1 = Mid(MyStr, CharCount + 2, 1)
NextCharPlus2 = Mid(MyStr, CharCount + 3, 1)
If IsNumeric(ThisChar) And _
IsNumeric(NextChar) And _
IsNumeric(NextCharPlus1) And _
IsNumeric(NextCharPlus2) Then

Number = Mid(MyStr, CharCount, 4)
.Range("IV" & RowCount) = Number
Exit For
End If
Next CharCount
Next RowCount
End With

'get number in sheet 2 column A
With Sheets("Sheet2")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 1 To LastRow
MyStr = .Range("A" & RowCount)
For CharCount = 1 To (Len(MyStr) - 3)
ThisChar = Mid(MyStr, CharCount, 1)
NextChar = Mid(MyStr, CharCount + 1, 1)
NextCharPlus1 = Mid(MyStr, CharCount + 2, 1)
NextCharPlus2 = Mid(MyStr, CharCount + 3, 1)
If IsNumeric(ThisChar) And _
IsNumeric(NextChar) And _
IsNumeric(NextCharPlus1) And _
IsNumeric(NextCharPlus2) Then

Number = Mid(MyStr, CharCount, 4)
Exit For
End If
Next CharCount

Quant = .Range("B" & RowCount)
Description = .Range("C" & RowCount)

'search for number in sheet 3
With Sheets("Sheet3")
Set c = .Columns("IV").Find(what:=Number, _
LookIn:=xlValues, lookat:=xlWhole)

If Not c Is Nothing Then
.Range("D" & c.Row) = Quant
.Range("E" & c.Row) = Description
End If

End With

Next RowCount


End With

Sheets("Sheet3").Columns("IV").Delete

End Sub
 
J

Joel

I added two message boxes to help locate the problem

Sub CombineSheetsNew()

'Copy sheet 1 to sheet 3
Sheets("Sheet1").Cells.Copy _
Destination:=Sheets("Sheet3").Cells

'Put 4 digit number in column IV
With Sheets("Sheet3")
'put 4 digit numbers in column IV
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 1 To LastRow
MyStr = .Range("C" & RowCount)
For CharCount = 1 To (Len(MyStr) - 3)
ThisChar = Mid(MyStr, CharCount, 1)
NextChar = Mid(MyStr, CharCount + 1, 1)
NextCharPlus1 = Mid(MyStr, CharCount + 2, 1)
NextCharPlus2 = Mid(MyStr, CharCount + 3, 1)
If IsNumeric(ThisChar) And _
IsNumeric(NextChar) And _
IsNumeric(NextCharPlus1) And _
IsNumeric(NextCharPlus2) Then

Number = Mid(MyStr, CharCount, 4)
.Range("IV" & RowCount) = Number
Exit For
End If
Next CharCount
Next RowCount
End With

'get number in sheet 2 column A
With Sheets("Sheet2")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 1 To LastRow
MyStr = .Range("A" & RowCount)
MsgBox ("Getting file : " & MyStr)
For CharCount = 1 To (Len(MyStr) - 3)
ThisChar = Mid(MyStr, CharCount, 1)
NextChar = Mid(MyStr, CharCount + 1, 1)
NextCharPlus1 = Mid(MyStr, CharCount + 2, 1)
NextCharPlus2 = Mid(MyStr, CharCount + 3, 1)
If IsNumeric(ThisChar) And _
IsNumeric(NextChar) And _
IsNumeric(NextCharPlus1) And _
IsNumeric(NextCharPlus2) Then

Number = Mid(MyStr, CharCount, 4)
Exit For
End If
Next CharCount

Quant = .Range("B" & RowCount)
Description = .Range("C" & RowCount)

'search for number in sheet 3
With Sheets("Sheet3")
Set c = .Columns("IV").Find(what:=Number, _
LookIn:=xlValues, lookat:=xlWhole)

If Not c Is Nothing Then
.Range("D" & c.Row) = Quant
.Range("E" & c.Row) = Description
Else
MsgBox ("could not find : " & Number)
End If

End With

Next RowCount
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Copying Data Down the Column But Only Based on What's in Column A 1

Top