Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Copying rows based on four digits and finding a match
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 23
Default Copying rows based on four digits and finding a match

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
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Copying rows based on four digits and finding a match
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
Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Copying rows based on four digits and finding a match
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
Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 23
Default Copying rows based on four digits and finding a match

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
Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Copying rows based on four digits and finding a match

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
Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 23
Default Copying rows based on four digits and finding a match

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
Reply With QuoteReply With Quote
  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Copying rows based on four digits and finding a match

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
Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
code for Copying rows based on a value Mir Khan Excel Programming 2 April 1st 08 07:05 PM
Copying rows based on date flurry[_5_] Excel Programming 4 June 3rd 06 06:05 PM
Copying whole rows based upon one criteria kirbster1973 Excel Discussion (Misc queries) 2 May 26th 05 10:00 PM
Copying rows of data based on a value in a cell. Screamerz Excel Programming 4 December 16th 04 01:40 PM


All times are GMT +1. The time now is 11:16 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement