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...
--
Kind regards, Nic

I posted the solution in his previous request.

"Nic Daniels" wrote:

> 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...
> --
> Kind regards, Nic

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


"Nic Daniels" wrote:

> 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...
> --
> Kind regards, Nic

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?




--
Kind regards, Nic


"Joel" wrote:

> 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
>
>
> "Nic Daniels" wrote:
>
> > 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...
> > --
> > Kind regards, Nic

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


"Nic Daniels" wrote:

> 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?
>
>
>
>
> --
> Kind regards, Nic
>
>
> "Joel" wrote:
>
> > 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
> >
> >
> > "Nic Daniels" wrote:
> >
> > > 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...
> > > --
> > > Kind regards, Nic

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




--
Kind regards, Nic


"Joel" wrote:

> 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
>
>
> "Nic Daniels" wrote:
>
> > 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?
> >
> >
> >
> >
> > --
> > Kind regards, Nic
> >
> >
> > "Joel" wrote:
> >
> > > 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
> > >
> > >
> > > "Nic Daniels" wrote:
> > >
> > > > 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...
> > > > --
> > > > Kind regards, Nic

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



"Nic Daniels" wrote:

> 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
>
>
>
>
> --
> Kind regards, Nic
>
>
> "Joel" wrote:
>
> > 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
> >
> >
> > "Nic Daniels" wrote:
> >
> > > 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?
> > >
> > >
> > >
> > >
> > > --
> > > Kind regards, Nic
> > >
> > >
> > > "Joel" wrote:
> > >
> > > > 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
> > > >
> > > >
> > > > "Nic Daniels" wrote:
> > > >
> > > > > 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...
> > > > > --
> > > > > Kind regards, Nic