PDA

View Full Version : Solved: search for first blank cell then paste clip board across sheets



mperrah
04-25-2007, 11:58 PM
I recorded a macro to copy data I want to paste to another sheet in the same workbook, I'm just not sure how to search down the column for the first empty cell to paste the data.

The contents are on the raw sheet and I want them to go in the first empty row on the QCDetail sheet
I made a command button on the Data sheet to click to preform the macro. The recording is not complete, but a start.

also there are several named ranges, is there a way to make the ranges dynamic, so when I add more rows the range includes the new data?

Thank you in advance,
hello MD if you see this, you seem to find my questions right away.
Mark
I'm trying to attach the file but even zipped it is 400 kb.
I'll try seperating each sheet

mperrah
04-26-2007, 12:01 AM
Here is 1 of 4 sheet 1 QCDetail

mperrah
04-26-2007, 12:04 AM
My data page is still 368 kb after zipping?
I'll put 3 and 4 up

mperrah
04-26-2007, 12:06 AM
this is a form that some info gets added to then printed

mperrah
04-26-2007, 12:08 AM
this is the raw data that gets pasted to the "data" sheet and sent every where else by from macros

mperrah
04-26-2007, 12:51 AM
I searched the forum for ExcelDiet. I remembered reading about a file to reduce size, wah lah.
Thank you KB

mperrah
04-26-2007, 12:55 AM
ExcelDiet reduced my complete file
So the QCDetail sheet has data I need to scan for the first blank row.
Then past the data from the "raw" sheet after removing some of the un-needed columns
Mark

Charlize
04-26-2007, 03:10 AM
?Sub Blank_last_row()
Dim QCDetail_row As Long
QCDetail_row = Worksheets("QCDetail").Range("A" & Rows.Count).End(xlUp).Row + 1
End SubEven when it is 7 (blank sheet only headers), first row will be 8. Otherwise it is a blank row.

Charlize

Charlize
04-26-2007, 03:28 AM
This is for the copying from the data to the qcdetail sheet. Just the number for now. Hope you'll like it.
Sub Charlize_detail()
Dim startrange As Range
Dim cell As Range
Dim QCDetail_row As Long
Set startrange = Worksheets("Data").Range("C3:C" & _
Worksheets("Data").Range("C" & Rows.Count).End(xlUp).Row)
QCDetail_row = Worksheets("QCDetail").Range("B" & Rows.Count).End(xlUp).Row + 1
For Each cell In startrange
With Worksheets("QCDetail")
cell.Copy .Range("B" & QCDetail_row)
QCDetail_row = QCDetail_row + 1
End With
Next cell
End Sub

mperrah
04-29-2007, 10:49 PM
I added your script and it does past the tech number line where I need it to go. How do I copy a whole row of data instead of just a cell?
I do have a few scripts already that add each row if it is checked to a page for printing or for making a new worksheet.
Now I'm looking to just move the data from a row on the "Data" worksheet to the "QCDetail" worksheet.
I can record a macro to put the columns of data into the correct order, but I need help getting the script to scan if the row is checked to send it to sheet(3) "QCDetail".

Also, the QC date will be filled in after the data has been copied over. If it is easier not to skip a cell I can type the date on the data sheet before running the script to copy?
Thanks for both your responses so far.
I still have a lot to learn in VBA :stars:
Mark

Charlize
04-30-2007, 12:18 AM
Put this in worksheet change event of data. Will copy row if status changes from no check to check. Once checked you should protect the cell so it can't be unchecked again.Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim CheckmarkCells As Range
Set CheckmarkCells = Range("A3:A1000")
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, CheckmarkCells) Is Nothing Then
If Target.Font.Name = "Marlett" Then
Target.ClearContents
Target.Font.Name = "Arial"
Target.Offset(0, 1).Select
Else
Target.Value = "a"
Target.Font.Name = "Marlett"
Target.Offset(0, 1).Select
With Worksheets("QCDetail")
'offset column of checkmark = Techid
Target.Offset(0, 2).Copy .Range("B" & .Range("B" & Rows.Count).End(xlUp).Row + 1)
'offset column of checkmark = Techname
Target.Offset(0, 13).Copy .Range("A" & .Range("B" & Rows.Count).End(xlUp).Row)
End With
End If
End If
End SubThis is with a check on the checkmark :Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim CheckmarkCells As Range
Set CheckmarkCells = Range("A3:A1000")
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, CheckmarkCells) Is Nothing Then
If Target.Value = "a" Then
MsgBox "This row has already been processed !", vbCritical
'If Target.Font.Name = "Marlett" Then
' Target.ClearContents
' Target.Font.Name = "Arial"
' Target.Offset(0, 1).Select
Else
Target.Value = "a"
Target.Font.Name = "Marlett"
Target.Offset(0, 1).Select
With Worksheets("QCDetail")
'offset column of checkmark = Techid
Target.Offset(0, 2).Copy .Range("B" & .Range("B" & Rows.Count).End(xlUp).Row + 1)
'offset column of checkmark = Techname
Target.Offset(0, 13).Copy .Range("A" & .Range("B" & Rows.Count).End(xlUp).Row)
End With
End If
End If
End SubCharlize

mperrah
05-02-2007, 01:17 AM
I used what you gave me and made this
As you can see it's pretty crude, but it works.
I have another script that uses te check marked rows only to copy.
hat part of yours I couldn't get to work.
I'll paste that too.

Sub movetodetail()

Dim startrange1 As Range
Dim startrange2 As Range
Dim startrange3 As Range
Dim startrange4 As Range
Dim cell As Range
Dim sc1 As Long ' tech name L
Dim sc2 As Long ' tech # A
Dim sc3 As Long ' wo date C
Dim sc4 As Long ' wo # G

' tech name
Set startrange1 = Worksheets("Raw").Range("L1:L" & _
Worksheets("Raw").Range("L" & Rows.Count).End(xlUp).Row)
sc1 = Worksheets("QCDetail").Range("A" & Rows.Count).End(xlUp).Row + 1
For Each cell In startrange1
With Worksheets("QCDetail")
cell.Copy .Range("A" & sc1)
sc1 = sc1 + 1
End With
Next cell

' tech number
Set startrange2 = Worksheets("Raw").Range("A1:A" & _
Worksheets("Raw").Range("A" & Rows.Count).End(xlUp).Row)
sc2 = Worksheets("QCDetail").Range("B" & Rows.Count).End(xlUp).Row + 1
For Each cell In startrange2
With Worksheets("QCDetail")
cell.Copy .Range("B" & sc2)
sc2 = sc2 + 1
End With
Next cell

' skip column for qc date, next column wo date
Set startrange3 = Worksheets("Raw").Range("C1:C" & _
Worksheets("Raw").Range("C" & Rows.Count).End(xlUp).Row)
sc3 = Worksheets("QCDetail").Range("D" & Rows.Count).End(xlUp).Row + 1
For Each cell In startrange3
With Worksheets("QCDetail")
cell.Copy .Range("D" & sc3)
sc3 = sc3 + 1
End With
Next cell

' wo number
Set startrange4 = Worksheets("Raw").Range("G1:G" & _
Worksheets("Raw").Range("G" & Rows.Count).End(xlUp).Row)
sc4 = Worksheets("QCDetail").Range("E" & Rows.Count).End(xlUp).Row + 1
For Each cell In startrange4
With Worksheets("QCDetail")
cell.Copy .Range("E" & sc4)
sc4 = sc4 + 1
End With
Next cell

End Sub

mperrah
05-02-2007, 01:21 AM
Option Explicit
Option Base 0
Sub detail()
Dim src As Worksheet ' source Data was DataWks
Dim trg As Worksheet ' target QCDetail was FormWks
Dim myRng As Range
Dim myCell As Range
Dim iCtr As Long
Dim myAddresses As Variant
Dim lOrders As Long
Set src = Worksheets("Data")
Set trg = Worksheets("QCDetail")

myAddresses = Array("A100", "B100", "C100", "D100", "E100")
' I need to vary A100 to be the next empty cell in the column
' for each iteration
With src
'first row of data to last row of data in column B
Set myRng = .Range("B3", .Cells(.Rows.Count, "B").End(xlUp))
End With
For Each myCell In myRng.Cells
With myCell
If IsEmpty(.Offset(0, -1)) Then
'if the row is not marked, do nothing
ElseIf myCell.Offset(0, -1).Value = "a" Then
For iCtr = LBound(myAddresses) To UBound(myAddresses)
trg.Range(myAddresses(iCtr)).Value = myCell.Offset(0, iCtr).Value
Next iCtr
Application.Calculate 'just in case
lOrders = lOrders + 1
End If
End With
Next myCell

'sc = Worksheets("QCDetail").Range("E" & Rows.Count).End(xlUp).Row + 1
'For Each cell In startrange
' With Worksheets("QCDetail")
' cell.Copy .Range("E" & sc)
' sc = sc + 1
' End With
'Next cell ' this part works for the raw data, how to adapt it
' for the "Data" sheet with an x in the row to print with the command button

End Sub

mperrah
05-04-2007, 12:41 AM
Thank you Charlize,
I modified your code to copy all the columns I need.
I'm trying to get it to work with a command button instead
because I have three functions that work off the checked rows
and some rows I don't want to move to detail until I preform the QC in the field. If I can't complete the QC the row wont go to detail.
Here is what I have. I tried making this just a sub but the Target gives me trouble. Thank you again for getting me this far
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim CheckmarkCells As Range
Set CheckmarkCells = Range("A3:A1000")
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, CheckmarkCells) Is Nothing Then
If Target.Font.Name = "Marlett" Then
Target.ClearContents
Target.Font.Name = "Arial"
Target.Offset(0, 1).Select
Else
Target.Value = "a"
Target.Font.Name = "Marlett"
Target.Offset(0, 1).Select
With Worksheets("QCDetail")
'offset column of checkmark = Techid
Target.Offset(0, 2).Copy .Range("B" & .Range("B" & Rows.Count).End(xlUp).Row + 1)
'offset column of checkmark = Techname
Target.Offset(0, 13).Copy .Range("A" & .Range("B" & Rows.Count).End(xlUp).Row)
'offset column of checkmark = wo date
Target.Offset(0, 4).Copy .Range("D" & .Range("B" & Rows.Count).End(xlUp).Row)
'offset column of checkmark = wo number
Target.Offset(0, 8).Copy .Range("E" & .Range("B" & Rows.Count).End(xlUp).Row)
'offset column of checkmark = QC Date
Target.Offset(0, 15).Copy .Range("C" & .Range("B" & Rows.Count).End(xlUp).Row)

End With
End If
End If
End Sub

Charlize
05-04-2007, 02:06 AM
This is for a commandbutton. You can't use target because that is a range for a worksheet_event.Sub Charlize_Single_Detail()
Dim sh_source As Worksheet
Dim sh_dest As Worksheet
Set sh_source = Worksheets("Data")
Set sh_dest = Worksheets("QCDetail")
If ActiveSheet.Name <> "Data" Then
MsgBox "Only perform this macro when Data-sheet is visible." & vbCrLf & _
"You must select a cell on a row that you want to copy" & vbCrLf & _
"to QCDetail-sheet.", vbInformation
Exit Sub
ElseIf ActiveCell.Row < 3 Or ActiveCell.Row > _
Worksheets("Data").Range("C" & Rows.Count).End(xlUp).Row Then
MsgBox "Select a row with data in it.", vbExclamation
Exit Sub
End If

With sh_source
.Range("C" & ActiveCell.Row).Copy sh_dest.Range("B" & _
sh_dest.Range("B" & Rows.Count).End(xlUp).Row + 1)
.Range("N" & ActiveCell.Row).Copy sh_dest.Range("A" & _
sh_dest.Range("B" & Rows.Count).End(xlUp).Row)
.Range("E" & ActiveCell.Row).Copy sh_dest.Range("D" & _
sh_dest.Range("B" & Rows.Count).End(xlUp).Row)
.Range("I" & ActiveCell.Row).Copy sh_dest.Range("E" & _
sh_dest.Range("B" & Rows.Count).End(xlUp).Row)
'??? offset column of checkmark = QC Date
.Range("P" & ActiveCell.Row).Copy sh_dest.Range("C" & _
sh_dest.Range("B" & Rows.Count).End(xlUp).Row)
End With
End SubCharlize

mperrah
05-04-2007, 12:38 PM
Thank you Charlize,
I am having trouble selecting multiple rows. Some times it makes duoble entries. How can I have the sub scan if column "A" has an "a" in it and only copy these. The worksheet change puts a Martlett letter a which looks like a check mark.
If I just select a row in column "A" your sub works great, but when I need more then one row it does different things.
My macro moves the focus one cell to the right after clicking, if I have a check and the the cell to the right also highlighted it makes 2 copies.
Can I have the sub only see the check and not the active cell?
Thanks again for all your help.
Mark

Charlize
05-06-2007, 01:13 PM
Better use doubleclick event for setting a checkmark instead of the worksheet change event. When you move cursor around and NOT moving in column A (column with checkmark) there will be no event. When column is A then when you move the copy off the row will take place due to the change event. If you want to copy the rows that have a checkmark, you need an extra column to check if the row has already been copied. That way you can put your checkmarks and afterwards process the whole thing by using a commandbutton.

Charlize

ps. Either use the change event or use a commandbutton.

mperrah
05-06-2007, 10:24 PM
Yes, that is what I'm working towards.
In my module modprint, the macro scans for a check in column "a" and fills the array of myAddresses on a target form and then prints. I don't know how to modify the "myAddresses" section to just copy to the next empty row on the qcdetail sheet.
Your macro using selection change works, but I dont know how to code it for the command button instead of the selection change.

Here is what I use it for.
I first update the data "Update jobs" button, then I print some to qc in the field "Print qc form" button after checking some rows,
then of the jobs I can score pass or fail I make the qcdetail, I want to uncheck the few I couldn't get to and copy the rows left checked to the qcdetail sheet. I dont need test if a row has been copied

mperrah
05-06-2007, 10:48 PM
I have the selection_change still in effect here, not sure how to modify it for comand button looking for an "a" in column"A"

If I could alter the "myAddresses" portion I think it would rock

Thank you for your patients
Mark

Charlize
05-08-2007, 01:35 AM
Try this for copying all the checkmarks. I have added a column to know when a row has been copied. You can set a couple of checkmarks and test this. Button Add to Detail on data sheet.Sub Charlize_Single_Detail()
Dim sh_source As Worksheet
Dim sh_dest As Worksheet
Dim cell As Range

Set sh_source = Worksheets("Data")
Set sh_dest = Worksheets("QCDetail")

If ActiveSheet.Name <> "Data" Then
MsgBox "Only perform this macro when Data-sheet is visible.", vbInformation
Exit Sub
End If
For Each cell In sh_source.Range("C3:C" & _
sh_source.Range("C" & Rows.Count).End(xlUp).Row)
If cell.Offset(, -2).Value = "a" And _
cell.Offset(, 18).Value <> "a" Then
With sh_source
.Range("C" & cell.Row).Copy sh_dest.Range("B" & _
sh_dest.Range("B" & Rows.Count).End(xlUp).Row + 1)
.Range("N" & cell.Row).Copy sh_dest.Range("A" & _
sh_dest.Range("B" & Rows.Count).End(xlUp).Row)
.Range("E" & cell.Row).Copy sh_dest.Range("D" & _
sh_dest.Range("B" & Rows.Count).End(xlUp).Row)
.Range("I" & cell.Row).Copy sh_dest.Range("E" & _
sh_dest.Range("B" & Rows.Count).End(xlUp).Row)
'??? offset column of checkmark = QC Date
.Range("P" & cell.Row).Copy
sh_dest.Range("C" & sh_dest.Range("B" & _
Rows.Count).End(xlUp).Row).PasteSpecial xlPasteValues
.Range("U" & cell.Row).Value = "a"
.Range("U" & cell.Row).Font.Name = "Marlett"
End With
End If
Next cell
End SubCharlize

ps. In your worksheet change event of data place a ' before the actual lines where the copying takes place. Module of change eventPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim CheckmarkCells As Range
Set CheckmarkCells = Range("A3:A1000")
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, CheckmarkCells) Is Nothing Then
If Target.Font.Name = "Marlett" Then
Target.ClearContents
Target.Font.Name = "Arial"
Target.Offset(0, 1).Select
Else
Target.Value = "a"
Target.Font.Name = "Marlett"
Target.Offset(0, 1).Select
'With Worksheets("QCDetail")
'offset column of checkmark = Techid
' Target.Offset(0, 2).Copy .Range("B" & .Range("B" & Rows.Count).End(xlUp).Row + 1)
'offset column of checkmark = Techname
' Target.Offset(0, 13).Copy .Range("A" & .Range("B" & Rows.Count).End(xlUp).Row)
'offset column of checkmark = wo date
' Target.Offset(0, 4).Copy .Range("D" & .Range("B" & Rows.Count).End(xlUp).Row)
'offset column of checkmark = wo number
' Target.Offset(0, 8).Copy .Range("E" & .Range("B" & Rows.Count).End(xlUp).Row)
'offset column of checkmark = QC Date
' Target.Offset(0, 15).Copy .Range("C" & .Range("B" & Rows.Count).End(xlUp).Row)

'End With
End If
End If
End Sub

mperrah
05-12-2007, 08:54 AM
you got it! Thank you for al? your help. I have to edit some date formatting and figure out addins for excell 2007, then I'll paste the final.
thanks again
Mark

mperrah
05-13-2007, 08:45 AM
I just upgraded to 2007 Office 2007 and my chart stopped working.
MD helped with sumproduct and weeknum() functions and I found help for elimenating zero values. When I change the weeknum range an error shows up on the chart saying data out of range?
I have named ranges that look in three columns but they incorporate the weeknum area. Does 2007 not support add-ins?
please help.
Mark:banghead:

mperrah
05-17-2007, 01:12 AM
I'm not sure what part of the charting stopped working in the 2007 upgrade but it had something to do with the formulas to remove the zero labels. I added a named range for each of the data values I was trcking in the chart. Then I matched the sumproduct format for the qcdetail page that counts the pass and fail items within the weeknum() result. I also found a macro to delete the zero labels instead of the 4x27 array worth of formulas that stopped working.

If someone knows how to make the NoZeroChart macro run when the WkStart value gets changed I think that will zip up this project.

Thanks again for the help Charlize, :friends:
Mark