oleg_v
04-11-2010, 11:48 AM
hi
i need a help with a macro
attached file with my table
i need a macro will ask for a serial number that in sheet3 column "j" and then copy the entaere row to sheet1 the column b starting with "B2" but without the serial
lucas
04-11-2010, 01:06 PM
Here's a stab at it:
see attached example
Option Explicit
Sub Main()
Dim i As Long
Dim sernum As String
sernum = InputBox("Enter the serial number")
For i = TargetRow(Sheets("Sheet3"), 1) - 1 To 2 Step -1
If UCase(Sheets("Sheet3").Cells(i, 10).Value) = sernum Then
Sheets("Sheet3").Rows(i).Copy Sheets("Sheet1").Cells(TargetRow(Sheets("Sheet1"), 1), 1)
Sheets("Sheet1").Columns("J").Delete
End If
Next i
End Sub
Function TargetRow(ByRef ws As Worksheet, ByVal col As Long) As Long
'returns index of first empty row from bottom of sheet
'requires worksheet object and column index
TargetRow = ws.Cells(Rows.Count, col).End(xlUp).Row
If IsEmpty(ws.Cells(TargetRow, col)) Then
'in this case the column is empty
'change targetrow to 2 to move the rows starting on the second row
TargetRow = 1
Else
TargetRow = TargetRow + 1
End If
End Function
oleg_v
04-12-2010, 04:04 AM
sorry but
i can not get it to work
I just tried Steve's attachment from #3. Seems to very nicely for me.
oleg_v
04-12-2010, 06:47 AM
sorry for my English
i meant to transpose the data to sheet1 starting in "b2" and downwards
Ah, I see now. Maybe:
Option Explicit
Sub TransposeVals()
Dim _
rngLCol_Dest As Range, _
rngSerialFound As Range, _
strSerialNum As String
'// Change sheetname(s) to suit//
With ThisWorkbook.Worksheets("Source")
strSerialNum = InputBox("Enter a serial number to find, as shown below:", _
vbNullString, _
.Range("J2").Value)
If strSerialNum = vbNullString Then Exit Sub
Set rngSerialFound = RangeFound(Range(.Range("J2"), .Cells(Rows.Count, "J")), strSerialNum)
If rngSerialFound Is Nothing Then
MsgBox "Sorry, not found...", 0, vbNullString
Exit Sub
End If
End With
With ThisWorkbook.Worksheets("Dest")
Set rngLCol_Dest = RangeFound(Range(.Range("B2"), .Cells(10, Columns.Count)), _
, , , , xlByColumns)
If rngLCol_Dest Is Nothing Then Set rngLCol_Dest = .Range("A2")
Range(.Cells(2, rngLCol_Dest.Column + 1), .Cells(10, rngLCol_Dest.Column + 1)).Value _
= Application.Transpose(Range(rngSerialFound.Offset(, -9), rngSerialFound.Offset(, -1)).Value)
End With
End Sub
Function RangeFound(SearchRange As Range, _
Optional FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range
If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If
Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function
Hope that helps,
Mark
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.