ipbr21054
Well-known Member
- Joined
- Nov 16, 2010
- Messages
- 5,832
- Office Version
- 2007
- Platform
- Windows
Afternoon,
I currently using this code below so it runs when i open the worksheet.
I am only interested in Column A
The range is ALWAYS A4:A28
What i would like please "as opposed to going to A4" is that when i open the worksheet the next available cell in column A without and value etc is selected.
So example would be cell A22 has a value in it so it would then select cell A23
The code for the page is currently shown below
I currently using this code below so it runs when i open the worksheet.
Code:
Private Sub Worksheet_Activate()Range("A4").Activate
End Sub
I am only interested in Column A
The range is ALWAYS A4:A28
What i would like please "as opposed to going to A4" is that when i open the worksheet the next available cell in column A without and value etc is selected.
So example would be cell A22 has a value in it so it would then select cell A23
The code for the page is currently shown below
Code:
Private Sub CommandButton1_Click() Sheets("EXPENSES (2)").Range("D4").Value = Sheets("EXPENSES (1)").Range("D30").Value
Sheets("EXPENSES (2)").Range("F4:K4").Value = Sheets("EXPENSES (1)").Range("F30:K30").Value
Sheets("EXPENSES (2)").Activate
ActiveSheet.Range("A5").Select
If Sheets("EXPENSES (2)").Range("K32").Value <> Sheets("EXPENSES (1)").Range("K32").Value Then MsgBox "Balance of sheets incorrect", vbCritical, "K32 CELLS DO NOT MATCH"
End Sub
Private Sub CommandButton2_Click()
Dim Answer As Long, wb As Workbook
Answer = MsgBox("Transfer Values To Summary Sheet ?", vbYesNo + vbInformation, "End Of Month Accounts")
If Answer = vbYes Then
Set wb = Workbooks.Open(Filename:="C:\Users\Ian\Desktop\EBAY\ACCOUNTS\CURRENT SHEETS\SUMMARY SHEET.xlsm")
Workbooks("ACCOUNTS.xlsm").Sheets("EXPENSES (1)").Range("D30").Copy
wb.Sheets("Sheet1").Range("I28").PasteSpecial xlPasteValues
Workbooks("ACCOUNTS.xlsm").Sheets("EXPENSES (1)").Range("F30").Copy
wb.Sheets("Sheet1").Range("I29").PasteSpecial xlPasteValues
Workbooks("ACCOUNTS.xlsm").Sheets("EXPENSES (1)").Range("G30").Copy
wb.Sheets("Sheet1").Range("I30").PasteSpecial xlPasteValues
Workbooks("ACCOUNTS.xlsm").Sheets("EXPENSES (1)").Range("H30").Copy
wb.Sheets("Sheet1").Range("I31").PasteSpecial xlPasteValues
Workbooks("ACCOUNTS.xlsm").Sheets("EXPENSES (1)").Range("I30").Copy
wb.Sheets("Sheet1").Range("I32").PasteSpecial xlPasteValues
Workbooks("ACCOUNTS.xlsm").Sheets("EXPENSES (1)").Range("J30").Copy
wb.Sheets("Sheet1").Range("I33").PasteSpecial xlPasteValues
Workbooks("ACCOUNTS.xlsm").Sheets("EXPENSES (1)").Range("K30").Copy
wb.Sheets("Sheet1").Range("I34").PasteSpecial xlPasteValues
wb.Close True
End If
Workbooks("ACCOUNTS.xlsm").Sheets("EXPENSES (1)").Range("A4").Select
Application.CutCopyMode = False
MsgBox "Summary Transfer Completed", vbInformation, "SUCCESSFUL MESSAGE"
ActiveWorkbook.Save
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myStartCol As String
Dim myEndCol As String
Dim myStartRow As Long
Dim myLastRow As Long
Dim myRange As Range
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
' *** Specify columns to apply this to ***
myStartCol = "A"
myEndCol = "K"
' *** Specify start row ***
If (Target.Row > 3 And Target.Row < 29) Then
myStartRow = 4
Else: myStartRow = 29
End If
' Use first column to find the last row
If (Target.Row > 3 And Target.Row < 29) Then
myLastRow = 28
Else: myLastRow = 30
End If
' Build range to apply this to
Set myRange = Range(Cells(myStartRow, myStartCol), Cells(myLastRow, myEndCol))
' Clear the color of all the cells in range
Range("A4:K30").Interior.ColorIndex = 2
' Check to see if cell selected is outside of range
If Intersect(Target, myRange) Is Nothing Then Exit Sub
' This color will Highlight the row
If (Target.Row > 3 And Target.Row < 29) Then
Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 8
' This color will Highlight the column
Range(Cells(4, Target.Column), Cells(28, Target.Column)).Interior.ColorIndex = 8
Else
Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 3
End If
' This color will Highlight the cell in the row
If (Target.Row > 3 And Target.Row < 29) Then
Target.Interior.Color = vbGreen
Else
Target.Interior.Color = vbRed
End If
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
' Exit if more than one cell updated at a time
If Target.Count > 1 Then Exit Sub
' Check to see if value updated is in column B or D
If Target.Column = 2 Or Target.Column = 4 Then
Application.EnableEvents = False
If UCase(Cells(Target.Row, "B")) = "REFUND" Then
Cells(Target.Row, "D") = Abs(Cells(Target.Row, "D")) * -1
Else
If Cells(Target.Row, "B") = "" Then Cells(Target.Row, "D").ClearContents
End If
Application.EnableEvents = True
End If
If Not (Application.Intersect(Target, Range("A3:K28")) _
Is Nothing) Then
With Target
If Not .HasFormula Then
Application.EnableEvents = False
.Value = UCase(.Value)
Application.EnableEvents = True
End If
End With
End If
End Sub
Private Sub Worksheet_Activate()
Range("A4").Activate
End Sub