Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Loop Help
In my macro I read thru column "A" for a specified string of text, then paste
a range of values to another worksheet. However, when it finds duplicate entries from the first sheet it fails to paste any data onto the other worksheet? If the macro finds more than one entry for "sUserPart" how can I get each data set pasted on the other worksheet in contiguous rows? If the inital data from sUserPart is not duplicated I do not want to simply stack the data on to the other worksheet. '====== Option Explicit Dim sUserPart As String Dim sDate As String Dim Sh1LastRow Dim Sh1Range Dim Sh1Cell Dim sh1x1 As String Dim sh1x2 As String Dim sRowData As String Private Sub CommandButton1_Click() If UserPart.Value = "" Then 'from textbox1 MsgBox "You must enter a Value in " & """Part Number""" & " text box!" End If If IsDate(UserDate.Value) = False Then 'from textbox2 MsgBox "You must enter a valid date in " & """Job Due By""" & " text box in a Date format (mm/dd/yy)!" End If With Sheets("Part Number") Sh1LastRow = .Cells(Rows.Count, "A").End(xlUp).Row Set Sh1Range = .Range("A2:A" & Sh1LastRow) End With 'MsgBox Sh1LastRow 'for testing For Each Sh1Cell In Sh1Range If Sh1Cell.Value = sUserPart Then 'search column A for "sUserPart" (textbox1) sh1x1 = Replace(Sh1Cell.Address, "$", "") sh1x2 = Replace(sh1x1, "A", "") sRowData = sh1x1 & ":H" & sh1x2 'set address range 'MsgBox sRowData 'for testing 'if duplicate entry from sheet "Part Number" is found need to add both entries Sheets("Print Data").Unprotect "2000" Range(sRowData).Copy Destination:=Sheets("Print Data").Range("A2") 'paste Sheets("Print Data").Select Columns("A:H").Select Selection.Columns.AutoFit Range("A2").Select Sheets("Print Data").Protect "2000" End If Next Sh1Cell Unload Me End Sub '====== -- Regards VBA.Noob.Confused XP Pro Office 2007 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Loop Help
I managed to figure this out. I was not returning to the original sheet to
collect data, hence the next row would be blank and that is he data copied. This code: '====== Sheets("Part Number").Activate '****New code End If Next Sh1Cell Unload Me End Sub '====== Was this code: '====== End If Next Sh1Cell Unload Me End Sub '====== Some times it's so simple it's hard to see. I give credit for me being able to find such an error to this NG!!! -- Regards VBA.Noob.Confused XP Pro Office 2007 "Rick S." wrote: In my macro I read thru column "A" for a specified string of text, then paste a range of values to another worksheet. However, when it finds duplicate entries from the first sheet it fails to paste any data onto the other worksheet? If the macro finds more than one entry for "sUserPart" how can I get each data set pasted on the other worksheet in contiguous rows? If the inital data from sUserPart is not duplicated I do not want to simply stack the data on to the other worksheet. '====== Option Explicit Dim sUserPart As String Dim sDate As String Dim Sh1LastRow Dim Sh1Range Dim Sh1Cell Dim sh1x1 As String Dim sh1x2 As String Dim sRowData As String Private Sub CommandButton1_Click() If UserPart.Value = "" Then 'from textbox1 MsgBox "You must enter a Value in " & """Part Number""" & " text box!" End If If IsDate(UserDate.Value) = False Then 'from textbox2 MsgBox "You must enter a valid date in " & """Job Due By""" & " text box in a Date format (mm/dd/yy)!" End If With Sheets("Part Number") Sh1LastRow = .Cells(Rows.Count, "A").End(xlUp).Row Set Sh1Range = .Range("A2:A" & Sh1LastRow) End With 'MsgBox Sh1LastRow 'for testing For Each Sh1Cell In Sh1Range If Sh1Cell.Value = sUserPart Then 'search column A for "sUserPart" (textbox1) sh1x1 = Replace(Sh1Cell.Address, "$", "") sh1x2 = Replace(sh1x1, "A", "") sRowData = sh1x1 & ":H" & sh1x2 'set address range 'MsgBox sRowData 'for testing 'if duplicate entry from sheet "Part Number" is found need to add both entries Sheets("Print Data").Unprotect "2000" Range(sRowData).Copy Destination:=Sheets("Print Data").Range("A2") 'paste Sheets("Print Data").Select Columns("A:H").Select Selection.Columns.AutoFit Range("A2").Select Sheets("Print Data").Protect "2000" End If Next Sh1Cell Unload Me End Sub '====== -- Regards VBA.Noob.Confused XP Pro Office 2007 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Naming Worksheets - Loop within a loop issue | Excel Programming | |||
Naming Worksheets - Loop within a loop issue | Excel Programming | |||
(Complex) Loop within loop to create worksheets | Excel Programming | |||
Advancing outer Loop Based on criteria of inner loop | Excel Programming | |||
Problem adding charts using Do-Loop Until loop | Excel Programming |