vb formatting cell (200/2003)

Topic

New Reply

Hello,
I have a vb and need to add commands to format a cell as soon as the person presses enter in column j. For example, range (a1:j1) cells are yellow. I want the row below and the same range format the same as above (a1:j1) as soon as the user enters information in j1. I also want a sequence of numbers in column a. In this case, a1 currently shows a 1. I want a2 to show 2 as soon as the user enters information in columm j and so on. Any help would be great.

Reply | Quote

Replies

The attached workbook should be all that you want and more (see comments in the code for the definition of more). To start out, press the Home key. HTH, Sam
Here is the code for those who do not want to open the workbook:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With Target
        If .Column  1 Then Exit Sub
        If .Row  Target.Parent.UsedRange.Rows.Count + 1 Then Exit Sub
        Dim i As Integer
        ' Increment column A
        .Value = .Offset(-1, 0) + 1
        ' Copy & paste previous row's formats
        .Offset(-1).EntireRow.Copy
        .EntireRow.PasteSpecial Paste:=xlPasteFormats
        For i = 0 To 9  ' If previous row has a formula, copy it
            If .Offset(-1, i).HasFormula Then _
                .Offset(-1, i).Copy .Offset(0, i)
        Next i
        .Next.Select    ' Skip to column B
    End With
End Sub

Reply | Quote

I think that Sammy’s code has a number of problems. It uses the Selection Change event which will introduce a lot of extra unnessary overhead. It will not do what you want if you paste values into a number of cells in column J at the same time. It will put the incorrect value in column A if the cell in column A in the row above the cell in column J that was changed does not have a value in it. It also copies formulas from the other cells in the range A1:J1 in the row above the row changed to the row that was changed, and you did not ask for that to happen. I would recommend replacing Sammy’s code with this:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim oCell As Range, oARng As Range
If Intersect(Target, Range("J:J")) Is Nothing Then Exit Sub
For Each oCell In Intersect(Target, Range("J:J"))
If oCell.Value "" Then
Set oARng = Selection
If oCell.Row = 1 Then
oCell.Offset(0, -9).Value = 1
Else
Application.EnableEvents = False
Range("A1:J1").Offset(oCell.Row - 2, 0).Copy
Range("A1:J1").Offset(oCell.Row - 1, 0).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
If IsNumeric(Range("A1").Offset(oCell.Row - 2, 0)) And Range("A1").Offset(oCell.Row - 2, 0) "" Then
Range("A1").Offset(oCell.Row - 1, 0) = Range("A1").Offset(oCell.Row - 2, 0) + 1
End If
oARng.Select
Application.EnableEvents = True
End If
End If
Next oCell
End Sub


Reply | Quote

> Sammy’s code has a number of problems
Can I plead it was Midnight when I posted? On the way to work this morning, I was thinking of adding an On Error Bail statement. It will not be pretty if the Target is A1!

> It uses the Selection Change event
I like your idea of using the Worksheet Change event, but if column J is left empty, then it will not fire, so there may be a problem there. But, why is the Selection Change more overhead?

> It will not do what you want if you paste values into a number of cells in column J.
True, I never thought of that

> It also copies formulas from the other cells in the range A1:J1 in the row above
I confess, I changed the design specs. But, I bet that aaa will like it so much that she will want it!

Two questions:

Your line

Reply | Quote

I haven’t tested the code, but I also don’t think your code will do anything if you change column J and hit tab to go to column K.

The selection change will be more overhead, because the event will fire every time the selection changes. For example, if I tab from cell to cell. Since nothing on the sheet changed, you are executing the event routine for no reason.

Intersect(Target, Range(“J:J”))

Reply | Quote

OK, so I think that we have several questions:
1) Will the user ever not make an entry in column J? If so, do you still want the auto-formatting when he goes to column A of the next row?
2) Do you want my copy formula feature?
3) Do you want to be able to paste more than one row of data and then have the auto-formatting occur on each of the lines or will there always be just a single line entry?

With these answers, someone will rewrite the code for you. HTH –Sam

Reply | Quote

Sammy: Just one point of clarification. The original poster never said “when he goes to column A of the next row.” What he said was “as soon as the person presses enter in column j.” Pressing Enter in column J could take you to a number of different places, depending on how the “Move selection after enter” option is set in the Edit tab of Tools/Options, and on what is selected when enter is hit. That is another reason I used the worksheet change event.

Reply | Quote

Yes, exactly. I assumed (always dangerous) that the user would always be enterting data & pressing the tab key to proceed to the cell to the right, then finally pressing the enter key after making an entry in column J to return to column A of the next row. Doing these automatic things is always dangerous, especially if you have multiple users. I have a spreadsheet that does running totals and inserts new lines in the middle of the sheet at appropriate times. I must have redesigned it a dozen times before I got predictible, useable, and appropriate behavior.

Reply | Quote

Sorry for all the confusion guys, but I still don’t know which code to use. Basically, I am attaching the file for reference. I want the person to fill all cells until they reach D7(which is merge all the way to J7). If any text is enter in this cell (d7) I want the worksheet to format the row below and put a 2(subsequent number from above)in A2 and format the same as the row above. I hope this helps to clarify the issue. Thanks.

Reply | Quote

Does the attached do what you want?

Reply | Quote

Thanks Legare. This does exactly what I wanted the user to do. One last question, I might be wrong, but for this macro to work the sheet has to be existing. I have a macro that will be inserting this sheet how can I make this part of that macro or call it. Thanks.

Reply | Quote

If you copy the worksheet with this code into a different book, the code will go with it, since the code is part of the worksheet.

Code like:

Workbooks("FormatRows.xls").Worksheets("Notes").Copy _
      Before:=Workbooks("OtherWorkbook.xls").Sheets(1)

can be used to copy it. Change the workbook and sheet names as desired.

Steve

Reply | Quote

I don’t think that is going to work. I am not trying to copy the code to another sheet, I am trying to included in another VB macro that adds the notes spreadsheet. I might be misunderstanding, but the code that was given to me applies only if the sheet exist. What do I do if I have a VB macro to add the sheet and I want to make the code part of it. Any help would be great.

Reply | Quote

By far the easiest way is to include the sheet complete with the code in the workbook, hidden if you like, and to copy it when you need a new one (and unhide it if necessary).

It is possible to add the code using a macro, but that requires that the user has ticked “Trust access to Visual Basic project” in the Trusted Sources tab of Tools | Macro | Security.
You must set a reference (in Tools | References… in the Visual Basic Editor) to the Microsoft Visual Basic for Applications Extensibility 5.3 library.
The code to create a new worksheet, and to add the Worksheet_Change event procedure is:

Sub AddSheetWithCode()
Dim wsh As Worksheet
Dim mdl As CodeModule
Dim lngLine As Long
Set wsh = Worksheets.Add
Set mdl = ActiveWorkbook.VBProject.VBComponents(wsh.Name).CodeModule
lngLine = mdl.CreateEventProc("Change", "Worksheet")
mdl.InsertLines lngLine + 1, _
" Dim oCell As Range, oARng As Range" & vbCrLf & _
" If Intersect(Target, Range(""D7:D65536"")) Is Nothing Then Exit Sub" & vbCrLf & _
" For Each oCell In Intersect(Target, Range(""D7:D65536""))" & vbCrLf & _
" If oCell.Value """" Then" & vbCrLf & _
" Set oARng = Selection" & vbCrLf & _
" Application.EnableEvents = False" & vbCrLf & _
" Range(""A1:J1"").Offset(oCell.Row - 1, 0).Copy" & vbCrLf & _
" Range(""A1:J1"").Offset(oCell.Row, 0).PasteSpecial Paste:=xlPasteFormats" & _
vbCrLf & _
" Application.CutCopyMode = False" & vbCrLf & _
" If IsNumeric(Range(""A1"").Offset(oCell.Row - 1, 0)) Then" & vbCrLf & _
" Range(""A1"").Offset(oCell.Row, 0) = " & _
"Range(""A1"").Offset(oCell.Row - 1, 0) + 1" & vbCrLf & _
" End If" & vbCrLf & _
" oARng.Select" & vbCrLf & _
" Application.EnableEvents = True" & vbCrLf & _
" End If" & vbCrLf & _
" Next oCell"
End Sub


Reply | Quote