L
Les
Hello all, i am using the code below to look in column "P", get the number
(2400239800) and then use the first 6 numbers and look up for the same number
on another sheet in a different workbook, if found offset 3 and copy the name
and past in "O" of the original document.
It does not however appear to find it when it is there ??
I have formated both columns as both text and general ??
Any help would be appreciated.
Sub InsertQMTResp()
'
'
Dim lookupRng As Range, LookUpCell As Range
Dim res As Variant, Month As String, sPath As String
Dim sBk As String, sSh As String
Dim bk As Workbook, sh As Worksheet
Dim bk1 As Workbook, rng As Range, r As Range
Dim bTom As Boolean, v As Variant
Dim cell As Range, cell1 As Range, myRng As Range
Dim ss As String, numSS As String, myRows As Long
Dim lastRow As Long
sPath = "\\nv09002\tpdrive\T-M-6\T-M-69\002_E90_WARRANTY\WARRANTY STAGE
4\Warranty Stage 4 Status\" & _
"Makro Project\"
sBk = "Einzelfalliste mit Teilen.xls"
sSh = "Hauptseite-1"
Set bk1 = Workbooks("Warranty_Makro.xls")
Set bk = Workbooks(sBk)
Set sh = bk.Worksheets(sSh)
Set r = ActiveSheet.UsedRange
lastRow = r.Rows.Count
myRows =
bk1.Worksheets("Responsibilities").Cells(Application.Rows.Count,
1).End(xlUp).Row
Set rng = sh.Range(sh.Cells(12, 15), sh.Cells(Rows.Count, 1).End(xlUp))
Set lookupRng = bk1.Worksheets("Responsibilities").Range("A2:A" & myRows)
For Each cell In rng
If cell.Offset(0, 15) > 0 Then
ss = cell.Offset(0, 15)
' store as a number (Long); for text it is (String) for lookup
numSS = ss
numSS = Trim(Left(numSS, 6))
res = Application.Match(numSS, lookupRng, 0)
If Not IsError(res) Then
Set cell1 = lookupRng(res)
cell1.Offset(0, 3).Copy
cell.Offset(0, 15).PasteSpecial xlValues
End If
End If
Next
End Sub
(2400239800) and then use the first 6 numbers and look up for the same number
on another sheet in a different workbook, if found offset 3 and copy the name
and past in "O" of the original document.
It does not however appear to find it when it is there ??
I have formated both columns as both text and general ??
Any help would be appreciated.
Sub InsertQMTResp()
'
'
Dim lookupRng As Range, LookUpCell As Range
Dim res As Variant, Month As String, sPath As String
Dim sBk As String, sSh As String
Dim bk As Workbook, sh As Worksheet
Dim bk1 As Workbook, rng As Range, r As Range
Dim bTom As Boolean, v As Variant
Dim cell As Range, cell1 As Range, myRng As Range
Dim ss As String, numSS As String, myRows As Long
Dim lastRow As Long
sPath = "\\nv09002\tpdrive\T-M-6\T-M-69\002_E90_WARRANTY\WARRANTY STAGE
4\Warranty Stage 4 Status\" & _
"Makro Project\"
sBk = "Einzelfalliste mit Teilen.xls"
sSh = "Hauptseite-1"
Set bk1 = Workbooks("Warranty_Makro.xls")
Set bk = Workbooks(sBk)
Set sh = bk.Worksheets(sSh)
Set r = ActiveSheet.UsedRange
lastRow = r.Rows.Count
myRows =
bk1.Worksheets("Responsibilities").Cells(Application.Rows.Count,
1).End(xlUp).Row
Set rng = sh.Range(sh.Cells(12, 15), sh.Cells(Rows.Count, 1).End(xlUp))
Set lookupRng = bk1.Worksheets("Responsibilities").Range("A2:A" & myRows)
For Each cell In rng
If cell.Offset(0, 15) > 0 Then
ss = cell.Offset(0, 15)
' store as a number (Long); for text it is (String) for lookup
numSS = ss
numSS = Trim(Left(numSS, 6))
res = Application.Match(numSS, lookupRng, 0)
If Not IsError(res) Then
Set cell1 = lookupRng(res)
cell1.Offset(0, 3).Copy
cell.Offset(0, 15).PasteSpecial xlValues
End If
End If
Next
End Sub