VB Code help on Worksheets

**VNouBA** · 05-23-2012, 06:54 AM

Here is another code from you that I manage to change a little but is still missing a lookup from Sheet5 "Report"

[VBA]

    If Not Intersect(Target, Range("I:I")) Is Nothing Then
    If Target.Cells.Count = 1 Then ' stops the code looping
        If LCase(Target.Value) = "yes" Then
            Range(Cells(Target.Row, 1), Cells(Target.Row, 1)).Copy
            Sheets("Evaluation").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Range("E" & TCol & ":G" & TCol).Copy
            Sheets("Report").Range("F" & TCol).PasteSpecial xlPasteValues
          Else
            Sheets("Report").Cells(Rows.Count, "F").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
          End If
        
        Range(Cells(Target.Row, 1), Cells(Target.Row, 9)).ClearContents
    End If
End If
End If

[/VBA]

When it the transfer is done, it needs to look-up A to make sure that it goes vs the same project number. is there a way to do this? then I should be ok for awhile.

**VNouBA** · 05-23-2012, 07:16 AM

Example of the transfer:

[VBA]Sheet “MERX”
A5 = Test
E5, F5 and G5 = Dates
If I5 has “yes” then Copy A5 to next sheet
Else
Copy E5, F5 and G5 then paste but lookup for “Test” in Column A in Sheet “Report” then paste E5, F5 and G5 to F*G*H*

Sheet “Report”

A5 = Run test
A6 = Tryout
A7 = Test… E5, F5 and G5 from sheet “MERX” will be copied to F7,G7 and H7.[/VBA]

**Tinbendr** · 05-23-2012, 08:38 AM

I must have uploaded the wrong file. I d/l the file at work to look at it and some of the code was 'missing'.

I'll have another look this evening when I get home.

**VNouBA** · 05-23-2012, 08:42 AM

You are the best...

If i find something that could help I will post it here.

**VNouBA** · 05-23-2012, 12:14 PM

I have the formula that would help with the comments.

Problem is to incorporate it in a VB code...

I have the following for Row 5 only.

Sheet"Report" Cell P5

PHP Code:


=CONCATENATE(VLOOKUP(A5,'Pre-Requisition'!A5:F30,6,FALSE)," ",VLOOKUP(A5,MERX!A5:H30,8,FALSE)," ",VLOOKUP(A5,Evaluation!A5:C30,3,FALSE))

**Tinbendr** · 05-24-2012, 04:18 AM

OK, I DID u/l the right one. It was just full of potholes.

Give it a test run.

Question. What about multiple contracts on the Contract page? When I enter a number > 1, the code inserts that number of contracts. How will 002 end up on the reports page? Or will it?

Another thing. The comments. If you need the comments in order, but the pages are edited out of order, we may have to have a update button or something to iterate through all the comments and put them in order for the Reports page.

**VNouBA** · 05-24-2012, 05:17 AM

Doing tests right now...

My page "MERX"; Column G stopped working. Will try to fix it.

[vba]
If Target.Column = 6 Then
Cells(Target.Row, "G").FormulaR1C1 = "=IF(RC6="""","""",RC6+90)"
End If
[/vba]

When I get to Sheet "Evaluation" and add a comment, it returns an error.

Question about the contract sheet. Each contract has it own row therefore becomes it's own but always attached to the Project number. When a delivery is completed it will go in the "Archives". I could always do a sort macro afterwards but for now it is not important.

By the way... Good work

I did also a couple of tweaks I will post the workbook this afternoon for you to look at when and if you have time. I appreciate your time.

**Tinbendr** · 05-24-2012, 05:59 AM

Originally Posted by VNouBA

Question about the contract sheet. Each contract has it own row therefore becomes it's own but always attached to the Project number.

That may pose a problem since there will be multiple project numbers with different contract numbers. How will we match up which line to move to the Reports?

**Tinbendr** · 05-24-2012, 06:07 AM

Originally Posted by VNouBA

My page "MERX"; Column G stopped working. Will try to fix it.
When I get to Sheet "Evaluation" and add a comment, it returns an error.

Just tried both of these, but no problems.
If you've had to start/stop with a break, make sure you rerun without any to see if it's ok.

**VNouBA** · 05-24-2012, 06:13 AM

I am trying to fix the original code from Sheet1 to the new code I have arrange and also to incorporate your code...

[vba]
TCol = Target.Row
If TCol > 4 Or TCol < 19 Then

If Not Intersect(Target, Range("G:G")) Is Nothing Then
If Target.Cells.Count = 1 Then ' stops the code looping
If LCase(Target.Value) = "yes" Then
Range(Cells(Target.Row, 1), Cells(Target.Row, 1)).Copy
Sheets("MERX").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Range(Cells(Target.Row, 1), Cells(Target.Row, 5)).Copy
Sheets("Report").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End If

Range(Cells(Target.Row, 1), Cells(Target.Row, 7)).ClearContents
End If
End If
End If
[/vba]

With this

[vba]
If Not Intersect(Target, Range("G:G")) Is Nothing Then
If Target.Cells.Count = 1 Then ' stops the code looping
If LCase(Target.Value) = "yes" Then
'Returns the row number of the same Project number on Reports Sheet.
RptProjRowNum = Application.WorksheetFunction.Match( _
ActiveSheet.Range("A" & TRow).Value, _
Worksheets("Report").Range("A5:A30"), 0) + 4

'Add Comments to report
Worksheets("Report").Range("P" & RptProjRowNum).Value = _
Worksheets("Report").Range("P" & RptProjRowNum).Value & "-" & _
Range("F" & TRow).Value
Range(Cells(Target.Row, 1), Cells(Target.Row, 8)).ClearContents
End If
End If
End If
Application.EnableEvents = True
End Sub
[/vba]

So that when I hit G "yes" it will only tranfer the file number to the next sheet and "Report" and also transfer the other relevant info to the "Report" sheet.

**Tinbendr** · 05-24-2012, 06:22 AM

Originally Posted by VNouBA

I and also transfer the other relevant info to the "Report" sheet.

You're already doing that eariler in the code.

[vba] If Target.Address = "$B$" & TRow Then
If Sheets("Report").Range("B" & TRow) = "" Then
Sheets("Report").Range("B" & TRow) = Target.Value
Else
Sheets("Report").Cells(Last(1, Sheets("Report").UsedRange), "B") = Target.Value
End If
[/vba]Etc...

Do you NOT want to copy it until Complete?

**VNouBA** · 05-24-2012, 06:29 AM

I guess it would be easier if Sheet1 would be transfer if complete yes.

This would elliminate the copy and pasting from other cells from sheet1

[VBA]
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.EnableEvents = False
If Not Intersect(Target, Range("B5:B100")) Is Nothing Then
frmCalendar.Show
End If
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range
Dim TCol As Long
TCol = Target.Row
If TCol > 4 Or TCol < 19 Then

If Not Intersect(Target, Range("G:G")) Is Nothing Then
If Target.Cells.Count = 1 Then ' stops the code looping
If LCase(Target.Value) = "yes" Then
Range(Cells(Target.Row, 1), Cells(Target.Row, 1)).Copy
Sheets("MERX").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Range(Cells(Target.Row, 1), Cells(Target.Row, 5)).Copy
Sheets("Report").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End If

Range(Cells(Target.Row, 1), Cells(Target.Row, 7)).ClearContents
End If
End If
End If
End Sub
[/VBA]

I guess this way it's more clean and you do not get confusion with the other sheets if you see the file number somewhere else.

If we transfer projects to sheet5 when it's complete then it's more of a flow with the projects.

Some will always stay on sheet1 for a long period of time. So this will help the flow form other files also?

What do you think?

I didn't think this was going to be a head rush HAHAHA but you are mind blowing me with your help

**VNouBA** · 05-24-2012, 06:35 AM

This code elliminates the cell by cell copy and paste… it takes the full row from column 1 to 6 then tranfer (copy) to sheet5 but also takes the Sheet1 project number and tranfer it to Sheet2 to continue the process.

So no need for the:

[VBA]
If Target.Address = "$B$" & TRow Then
If Sheets("Report").Range("B" & TRow) = "" Then
Sheets("Report").Range("B" & TRow) = Target.Value
Else
Sheets("Report").Cells(Last(1, Sheets("Report").UsedRange), "B") = Target.Value
End If
End If
If Target.Address = "$C$" & TRow Then
If Sheets("Report").Range("C" & TRow) = "" Then
Sheets("Report").Range("C" & TRow) = Target.Value
Else
Sheets("Report").Cells(Last(1, Sheets("Report").UsedRange), "C") = Target.Value
End If
End If
If Target.Address = "$D$" & TRow Then
If Sheets("Report").Range("D" & TRow) = "" Then
Sheets("Report").Range("D" & TRow) = Target.Value
Else
Sheets("Report").Cells(Last(1, Sheets("Report").UsedRange), "D") = Target.Value
End If
End If
If Target.Address = "$E$" & TRow Then
If Sheets("Report").Range("E" & TRow) = "" Then
Sheets("Report").Range("E" & TRow) = Target.Value
Else
Sheets("Report").Cells(Last(1, Sheets("Report").UsedRange), "E") = Target.Value
End If
End If
End If
[/VBA]

What do you think?

**Tinbendr** · 05-24-2012, 07:04 AM

Originally Posted by VNouBA

What do you think?

Yes, I agree. That makes the code of transfer from each page upon completion the same.

**VNouBA** · 05-24-2012, 07:27 AM

I'll try to incoprorate the "comment" code in the "Pre-Requisition" sheet.

Now everything will change lol.

I'll start working on the Sheet2 code... this will maybe cause some problem as when the "MERX" sheet will transfer information it will go on the next available row and not vs the projects number on sheet5 "Report".

**VNouBA** · 05-24-2012, 09:37 AM

Completed the code for Sheet "Pre-Requisition"

[VBA]
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range
Dim TRow As Long
Dim RptProjRowNum As Long
TRow = Target.Row
If TRow > 4 Or TRow < 19 Then

If Not Intersect(Target, Range("G:G")) Is Nothing Then
If Target.Cells.Count = 1 Then ' stops the code looping
If LCase(Target.Value) = "yes" Then
Range(Cells(Target.Row, 1), Cells(Target.Row, 1)).Copy
Sheets("MERX").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Range(Cells(Target.Row, 1), Cells(Target.Row, 5)).Copy
Sheets("Report").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
If LCase(Target.Value) = "yes" Then

'Returns the row number of the same Project number on Reports Sheet.
RptProjRowNum = Application.WorksheetFunction.Match( _
ActiveSheet.Range("A" & TRow).Value, _
Worksheets("Report").Range("A5:A1000"), 0) + 4

'Add Comments to report
Worksheets("Report").Range("P" & RptProjRowNum).Value = _
Worksheets("Report").Range("P" & RptProjRowNum).Value & "-" & _
Range("F" & TRow).Value

End If
Range(Cells(Target.Row, 1), Cells(Target.Row, 7)).ClearContents
End If
End If
End If
End If
End Sub
[/VBA]

**VNouBA** · 05-25-2012, 09:53 AM

Like you said... I'm stuck at Sheet4 "Contracts"

I have modified the workbook as per my manager's request but I think I managed to clean it up

If you dont mind having a look...

**VNouBA** · 05-25-2012, 12:06 PM

I think I have it and the Workbook will be completed...

I just dont know where to change or modify the last information...

The information is in the "Contracts"

If you need explanation let me know but it's only missing the transfer to the right row vs the contract number. I have modified the Vlookup information.

Instead of taking it from the Main project number it will take the information from the Contract Number...

I have attached my latest Workbook

**VNouBA** · 05-25-2012, 12:08 PM

Originally Posted by Tinbendr

That may pose a problem since there will be multiple project numbers with different contract numbers. How will we match up which line to move to the Reports?

From the "Number of contract(s)" instead of the "Requisition Number"

Once the contract is ready to be issued we do not need the Comments from the previous steps... Trying to figure out a code to clear the "comment" in Sheet "Report" when we add information in Column B in the "Contracts" Sheet.

**Tinbendr** · 05-25-2012, 07:38 PM

How about this approach? When you insert the rows for the number of contracts, also copy the same contract number to the Reports page. (Just like you were doing with the project number.) This way, you will have a way to look up the contract when copying the rest of the information from the Contracts upon completion.

In regards to the comments. If I understand you correctly, once the contracts are completed, all the previous comments from the other pages on the Reports are now obsolete? And they need to be replaced with the comments from the Contracts line to the Reports? If so, then

[vba]Worksheets("Report").Range("R" & RptProjRowNum).Value = _
Range("M" & TRow).Value[/vba]

Thread: VB Code help on Worksheets

Thread Tools

Display

First code works good

Posting Permissions