pulling data from another sheet

[AD108]

I am in the very early stages of learning programming. Any help would be
greatly appreciated.
I am attempting to pull data from cells on another sheet, by using matching
reference numbers.

Basically how I am attempting to do this is to loop through all the item
numbers on the sheet.
The first attempt is match a 12 digit UPC number, and if that doesn't return
a match on the data sheet, then it should check a second number, which
happens to be 6 digits. I was able to get the first part to work, but then
when I tried to add the condition (When the 12 digit code is not found,
check the 6 digit one, my code is failing.

Code is as follows...

Sub ExtractData()

Dim rngSub As Range
Dim Cell As Range
Dim x As Range
Dim i As Integer
Dim y As String
On Error Resume Next
Application.ScreenUpdating = False


For i = 2 To ActiveWorkbook.Sheets.Count - 1
'makes loop skip data sheet

Set rngSub =
Sheets(i).Range("N:N").SpecialCells(xlCellTypeConstants, 23)
'loop through all cells
For Each Cell In rngSub
'add the dash as the data sheet has dashes in the numbers
y = Left(Cell, 6) & "-" & Right(Cell, 6)
Debug.Print y
Set x = Sheets(1).Cells.Find(What:=y, LookAt:=xlPart)
Cell.Offset(0, 4).Value = x.Offset(0, 17).Value
Debug.Print x.Offset(0, 17).Value

'if 12 digit number does not match, attempt to find matching 5 digit number
If
Application.WorksheetFunction.CountBlank(Sheets(i).Cell.Offset(0, 4)) = 1
Then
y = Left(Cell.Offset(0, -11), 3) & "-" &
Right(Cell.Offset(0, -11), 3)
Debug.Print y
Set x = Sheets(1).Cells.Find _
(What:=y, LookAt:=xlWhole)
Cell.Offset(0, 4).Value = x.Offset(0, 15)


Next Cell
MsgBox Sheets(i).Name
Application.ScreenUpdating = True
Next i

End Sub

Thanks in advance,

Ad108

 

[Bob Phillips]

Maybe try this (I haven't tested it, don't understand the data)

Sub ExtractData()

Dim rngSub As Range
Dim Cell As Range
Dim x As Range
Dim i As Integer
Dim y As String
On Error Resume Next
Application.ScreenUpdating = False


For i = 2 To ActiveWorkbook.Sheets.Count - 1
'makes loop skip data sheet

Set rngSub =
Sheets(i).Range("N:N").SpecialCells(xlCellTypeConstants, 23)
'loop through all cells
For Each Cell In rngSub
'add the dash as the data sheet has dashes in the numbers
y = Left(Cell, 6) & "-" & Right(Cell, 6)
Debug.Print y
Set x = Sheets(1).Cells.Find(What:=y, LookAt:=xlPart)
If Not x Is Nothing Then
Cell.Offset(0, 4).Value = x.Offset(0, 17).Value
Debug.Print x.Offset(0, 17).Value
Else
'if 12 digit number does not match,
'attempt to find matching 5 digit number
y = Left(Cell.Offset(0, -11), 3) & "-" &
Right(Cell.Offset(0, -11), 3)
Debug.Print y
Set x = Sheets(1).Cells.Find _
(What:=y, LookAt:=xlWhole)
If Not x Is Nothing Then _
Cell.Offset(0, 4).Value = x.Offset(0, 15)
End If
Next Cell
MsgBox Sheets(i).Name
Application.ScreenUpdating = True
Next i

End Sub


BTW, best not to use constants when there is a declared constant available
(Specialcells value).

--
HTH

Bob Phillips

(remove xxx from email address if mailing direct)

 

[AD108]

Thanks a alot,

That solved the problem

Maybe try this (I haven't tested it, don't understand the data)

Sub ExtractData()

Dim rngSub As Range
Dim Cell As Range
Dim x As Range
Dim i As Integer
Dim y As String
On Error Resume Next
Application.ScreenUpdating = False


For i = 2 To ActiveWorkbook.Sheets.Count - 1
'makes loop skip data sheet

Set rngSub =
Sheets(i).Range("N:N").SpecialCells(xlCellTypeConstants, 23)
'loop through all cells
For Each Cell In rngSub
'add the dash as the data sheet has dashes in the numbers
y = Left(Cell, 6) & "-" & Right(Cell, 6)
Debug.Print y
Set x = Sheets(1).Cells.Find(What:=y, LookAt:=xlPart)
If Not x Is Nothing Then
Cell.Offset(0, 4).Value = x.Offset(0, 17).Value
Debug.Print x.Offset(0, 17).Value
Else
'if 12 digit number does not match,
'attempt to find matching 5 digit number
y = Left(Cell.Offset(0, -11), 3) & "-" &
Right(Cell.Offset(0, -11), 3)
Debug.Print y
Set x = Sheets(1).Cells.Find _
(What:=y, LookAt:=xlWhole)
If Not x Is Nothing Then _
Cell.Offset(0, 4).Value = x.Offset(0, 15)
End If
Next Cell
MsgBox Sheets(i).Name
Application.ScreenUpdating = True
Next i

End Sub


BTW, best not to use constants when there is a declared constant available
(Specialcells value).

--
HTH

Bob Phillips

(remove xxx from email address if mailing direct)