Products Managment Spreadsheet Problem

[joejoe]

Hello all ,
This is Joseph
i have A problem With Excel 2007 and Programming with it
I have made an Simple Product inventory Excel sheet ..
all what i need in it ...to program a kind of a spreadsheet that lookup for the part number in the inventory and copy all The Row that it exist in
First : the file of my homeinventory is homeinventory.xls
every row contains 8 columns (part number, refrence, ..etc) ..
all what i need is to search for a Single part number and copy its entire row and paste it in another spread sheet or even word sheet ..also ...if this macro can be putten in command button that's will be very nice...
i dunno if there is any way to do that
really i am sorry for my poor english (just self study of english )
also if there any one wants to help me directly ...my email is Removed e-mail address - You can put it in your profile - It's not secure out in the open - Moderator
if you don't understand what i mean ...just write some codes about
1- searching in spreadsheet for a partnumber that user write in Textbox
2- Copying the ENTIRE ROW of the result
3-pasting it in another sheet

and may also i know if i can put this codes in any other sheet (not the homeinventory sheet)

sorry for bothering
Joe


sheet picture

 

[al_b_cnu]

Hi Joe, welcome to the board!

Try the following:

1 From the menu View / toolbars / Control Toolbox
2 Click 'Command Button' icon and then on your sheet, click & drag to size
3 right-click the newly created command button & select 'View Code'
4 In the Properties window change the Caption to, say, 'Copy Data'
5 in the code window, delete everytjhing & replace with the following:

Option Explicit

Private Sub CommandButton1_Click()
Dim iColend As Integer
Dim lTargetRow As Long, lFindRow As Long
Dim vPartNumber As Variant, vFilename As Variant
Dim wsSourceSheet As Worksheet, wsTarget As Worksheet
Dim wbTarget As Workbook

'-- assume input part numbers are in currently active sheet --
Set wsSourceSheet = ActiveSheet

'-- Prompt for output workbook --
vFilename = Application.GetOpenFilename(filefilter:="Excel files (*.xls),*.xls", _
                                        Title:="Please select file for output")
If vFilename = False Then Exit Sub

Application.EnableEvents = False

'-- Open the w/book --
Set wbTarget = Workbooks.Open(Filename:=vFilename)

'-- Store data into first sheet of target w/book --
Set wsTarget = wbTarget.Sheets(1)
lTargetRow = wsTarget.Cells(Rows.Count, "A").End(xlUp).Row

iColend = 8

'-- Loop & prompt for part numbers to copy until user cancels --
Do
    vPartNumber = Application.InputBox(prompt:="Please enter Part Number required", _
                                     Title:="Part Number Copy", _
                                     Type:=2)
    If vPartNumber = False Then Exit Sub
    
    On Error Resume Next
    lFindRow = 0
    lFindRow = WorksheetFunction.Match(vPartNumber, wsSourceSheet.Columns("A"), 0)
    On Error GoTo 0
    If lFindRow = 0 Then
        MsgBox "Part number '" & vPartNumber & "' not found"
    Else
        lTargetRow = lTargetRow + 1
        wsTarget.Range("A" & lTargetRow, Cells(lTargetRow, iColend).Address).Value = _
            wsSourceSheet.Range("A" & lFindRow, Cells(lFindRow, iColend).Address).Value
    End If
    
Loop

Application.EnableEvents = True
End Sub

 

[joejoe]

Thanks Alan Really For your Help,Really This Forum Is the best forum Discussing Microsoft Excel ,
but there was problem for me ... It tells that There is No Part Num. , i tried to understand the code ...but it seems that it differ alot from the suffix of the vb6 programming.. So ....Maybe i Will tell you better thing ..
what is the code of :
1- Copying All The row Of Selected single Cell
2- Pasting in another sheet ( if i want to paste in new Row if the Previous row isnt empty )
3- Code of printing the page
4- Code Of SELECTING all the rows that contain one Suffix like "local"
5- Command Of saving To Webpage on office 2007
The excel sheet is the home inventory in http://www.vertex42.com/ExcelTemplates/inventory-spreadsheet.html

it is the same , but i made changes on its look only,
also If any one knows any macro to delete all the Similar items

Thanks For Help
And Sorry For Bothering
joe

 

[al_b_cnu]

Hi Joe,

This macro will append the selected rows to Sheet2:

Sub CopySelectedRows()
'******************************************
'** Copy selected rows to sheet "Sheet2" **
'******************************************
Dim lTargetRow As Long, lAreas As Long
Dim rCopyRange As Range, rCur As Range
Dim sSelected As String, sCurRow As String
Dim wsTarget As Worksheet

'-- Set target worksheet --
Set wsTarget = Sheets("Sheet2")

sSelected = ""
For lAreas = 1 To Selection.Areas.Count
    Set rCopyRange = Selection.Areas(lAreas)
    lTargetRow = wsTarget.Cells(Rows.Count, rCopyRange.Column).End(xlUp).Row
    For Each rCur In rCopyRange
        sCurRow = "," & CStr(rCur.Row) & ","
        If InStr(sSelected, sCurRow) = 0 Then
            sSelected = sSelected & sCurRow
            lTargetRow = lTargetRow + 1
            wsTarget.Rows(lTargetRow).Value = ActiveSheet.Rows(rCur.Row).Value
        End If
    Next rCur
Next lAreas
End Sub

This macro will select all rows with column A containing the specified text:

Sub SelectRows()
'*********************************************************
'** Select rows containing specified string in column A **
'*********************************************************
Dim laRows() As Long, lPtr As Long
Dim rFind As Range
Dim sFirstAddress As String, sRows As String
Dim vFind As Variant

vFind = Application.InputBox(prompt:="Please enter string to be searched for", _
                            Type:=2)
If vFind = False Then Exit Sub

ReDim laRows(0 To 0)
With ActiveSheet.Columns("A")
    Set rFind = .Find(vFind, lookat:=xlWhole)
    If Not rFind Is Nothing Then
        sFirstAddress = rFind.Address
        Do
            lPtr = UBound(laRows) + 1
            ReDim Preserve laRows(0 To lPtr)
            laRows(lPtr) = rFind.Row
            
            Set rFind = .FindNext(rFind)
            If rFind Is Nothing Then Exit Do
        Loop While rFind.Address <> sFirstAddress
    End If
End With

sRows = ""
For lPtr = 1 To UBound(laRows)
    sRows = sRows & "," & laRows(lPtr) & ":" & laRows(lPtr)
Next lPtr

Range(Mid$(sRows, 2)).Select

End Sub

Regarding printing the page, cant you just use the inbuilt Excel functionality?

Regarding saving to webpage, can you post as a seperate thread- I dont have Excel 2007

 

[joejoe]

Thanks Very Much For the code
The First code is right in copying the row ..the problem is ..i want something to copy the row of selected cell ...I mean if i am selecting the cell H2 .. it copy all the row "2" , ...All what i am going to do ..is to put the Code Of Searching In the spreadsheet ( I recorded the macro via ex2007) Also i will add your code in it ,...but the missing one ..how to select the row ....of the cell ...
the Other Code...Can you tell me where to put it ...on macro ..command button ...?.......
If you are Online ...Can you please help ..because i have 2 days to Date Enter all the products of the Company In the Database....Because Of Some Problems In the Product Pricings.....
1- Code of selecting row of selecting cell
2- Code of paste it in new row...
Sorry For Bothering
thanks alot ..

 

[al_b_cnu]

Hi Joe,

The first sub 'CopySelectedRows' will determine which cells have been selected and then append the contents of each row to sheet2.

So if you select cell H2, it will append row 2 to sheet2

If you select cell H2 and F6 and range G9:J13, it will append rows 2,6 and 9 to 13.

Regarding the 'SelectRows' macro, you can either place a command button in your sheet and in the Command button code place a call to 'SelectRows' as follows:

Call SelectRows

OR you can just select the macro to run from the menu (not sure where this is in 2007)

 

[joejoe]

Thanks Very Much al_b_cnu
Your Codes worked great With me , but i need to make little bit better or Complex,
see the " find " Tool in office .. (ctrl+F) , There is a Plugin called "find all" ...It is very great find all of them and put them in a list ...i need something like that ....and when i click on a line in the list ..it select it ...thats will be very great
see the image :

Also , It will Be great if Just it find all ..and copy all's rows ...and paste it in sheet 2, i mean " Copy all" Instead of "replace all "
thanks Alot
Joe

 

[joejoe]

Hey again
see this question in the expert exchange
I think It have all what i need
but i can't see the answer ..even in the free trial mode...dunno
So if you can answer this question for me ..thats wil be very nice
www.experts-exchange.com/OS/Microsoft_Operating_Systems/Q_22722787.<WBR>html

Sorry For bothering
joe

 

[joejoe]

Anybody here ?? ,,No One answered Or even Replied....

 

[al_b_cnu]

Hi,

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim lTargetRow As Long, lHitCount As Long
Dim rFindRange As Range, rFind As Range
Dim sFirstAddress As String, sTargetAddress As String
Dim wsTargetSheet As Worksheet

Cancel = True

If Target.Text = "" Then Exit Sub

Set wsTargetSheet = Sheets("Sheet2")
lTargetRow = wsTargetSheet.Cells(Rows.Count, Target.Column).End(xlUp).Row

sTargetAddress = Target.Address

With ActiveSheet.UsedRange
    Set rFindRange = Range(Cells(.Row, Target.Column).Address, _
                            Cells(.Row + .Rows.Count - 1, Target.Column).Address)
End With

lHitCount = 0
With rFindRange
    Set rFind = .Find(Target.Value, lookat:=xlWhole)
    If Not rFind Is Nothing Then
        sFirstAddress = rFind.Address
        Do
            lHitCount = lHitCount + 1
            lTargetRow = lTargetRow + 1
            wsTargetSheet.Rows(lTargetRow).Value = ActiveSheet.Rows(rFind.Row).Value
                
            Set rFind = .FindNext(rFind)
            If rFind Is Nothing Then Exit Do
        Loop While rFind.Address <> sFirstAddress
    End If
End With

MsgBox lHitCount & " rows appended to sheet '" & wsTargetSheet.Name & "'."

End Sub

To install:
Right-click your sheet tab, select 'View Code' and paste into code window.

To use:
double-click the cell you wish to have copied to Sheet2. The code will append all rows which contain the same value to Sheet2.