Change from Column Selection to Cell Selection

L

Lil Pun

Right now I have code setup so if a 1 is entered into a cell in Column
the active cell is made then made Cell C2. I want to change it so tha
it is a specific cell (A50) instead of the entire column.

Here is the code that does it now:
 
N

Norman Jones

Hi LiPun,

Try something like:

'=============>>
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub

If Not Intersect(Target, Me.Range("A50")) Is Nothing Then
On Error GoTo XIT
Application.EnableEvents = False
If Target.Value = 1 Then
Me.Range("C2").Select
Application.SendKeys "{F2}"
End If
End If
XIT:
Application.EnableEvents = True
End Sub
'<<=============
 
L

Lil Pun

I don't really want a whole new set of code, just change the code I have
because it is dependent on other parts of my project. I'll post the
parts of my project:

EXPORTCONTROL:
Private Sub CommandButton1_Click()

' Macro controls exports of marked sheet data as text files to the
Transfer file directory

Msg = "Do you want to proceed with the concatenation of the 2
files?"
Ans = MsgBox(Msg, vbYesNo)
If Ans = vbYes Then
Call ExportToResult 'Call Sub Procedure

Else

End If

End Sub

SHEET1:
Private Sub Worksheet_Activate()
avoidloop = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo errorhandler
If avoidloop And Trim(Target) <> "" Then
If Target = "1" Then
Range("C2").Select
Application.SendKeys "{F2}"
Else
Select Case (ActiveCell.Column)
Case 1
avoidloop = False
If
UCase(Left(ActiveSheet.Rows(2).Columns(1).Value, 8)) =
UCase(Left(Target, 8)) Then
ActiveSheet.Rows(ActiveCell.Row -
1).Columns(1).Value = Target
ActiveSheet.Rows(ActiveCell.Row -
1).Columns(2).Value = ""
avoidloop = True
Else
ActiveSheet.Rows(ActiveCell.Row -
1).Columns(2).Value = Target
ActiveSheet.Rows(ActiveCell.Row -
1).Columns(1).Value = ""
ActiveSheet.Rows(10).Columns(3).Value =
"9999"
avoidloop = True
End If
Case 2
Case 3
If ActiveCell.Row = 3 Then
If Target <> "" Then SAVE_DATA (Target)
End If

Case Else
End Select
End If
End If
errorhandler:
End Sub
MODULE1:

Global avoidloop As Boolean
Sub Macro1()
Range("A2").Select
End Sub
Sub SAVE_DATA(Target)
GoldenSheet = ActiveSheet.Name
Sheets.Add
NewSheet = ActiveSheet.Name


Sheets(GoldenSheet).Select
Columns("A:E").Select
Selection.Copy
Sheets(NewSheet).Select
ActiveSheet.Paste
Rem For i = 1 To 100
Rem Sheets(NewSheet).Cells(i, 1) = Sheets(GoldenSheet).Cells(i,
1)
Rem Sheets(NewSheet).Cells(i, 2) = Sheets(GoldenSheet).Cells(i,
2)
Rem Sheets(NewSheet).Cells(i, 3) = Sheets(GoldenSheet).Cells(i,
3)
Rem Rem Sheets(NewSheet).Cells(i, 4) =
Sheets(GoldenSheet).Cells(i, 4)
Rem Rem Sheets(NewSheet).Cells(i, 5) =
Sheets(GoldenSheet).Cells(i, 5)
Rem Next i

FullPathFile = Trim(Sheets("Control").Cells(3, 3)) &
Trim(Sheets("Control").Cells(4, 3)) & Trim(Target) & "-" & Year(Now) &
"-" & Format(Month(Now), "00") & "-" & Format(Day(Now), "00") & ".xls"
increment = 1
Do While (Dir(FullPathFile) <> "")
trim_ = InStr(FullPathFile, "_")
trimxls = InStr(FullPathFile, ".xls")
parcialpath = Left(FullPathFile, trimxls - 1)
If trim_ > 1 Then
parcialpath = Left(parcialpath, trim_ - 1)
FullPathFile = parcialpath & "_" & increment & ".xls"
Else
FullPathFile = parcialpath & "_" & increment & ".xls"
End If
increment = increment + 1
Loop
Rem tempfilename = active
Range("A2").Select
ActiveSheet.Cells(2, 4) = Hour(Now) & ":" & Format(Minute(Now),
"00") & ":" & Format(Second(Now), "00")
ActiveSheet.Cells(2, 5) = Year(Now) & "-" & Format(Month(Now),
"00") & "-" & Format(Day(Now), "00")
Range("A2").Select
ActiveWindow.SelectedSheets.Move
ActiveWorkbook.SaveAs Filename:=FullPathFile, FileFormat:=xlNormal,
_
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close
Rem ActiveWorkbook.Close
avoidloop = False
For i = 2 To 100
Sheets(GoldenSheet).Cells(i, 1) = ""
Sheets(GoldenSheet).Cells(i, 2) = ""
Sheets(GoldenSheet).Cells(i, 3) = ""
Next i
avoidloop = True
If Sheets("Control").CheckBox1.Value Then MsgBox "File " &
FullPathFile & " Created"
Range("A2").Select
Application.SendKeys "{F2}"


End Sub

Sub TransferLocation()

'Macro inserts transfer directory name from control button

Location = Application.GetOpenFilename("All files (*.*), *.*")

If Location <> False Then
FindSeparator = InStr(Location, "\")
Do While FindSeparator
GetPath = Left(Location, FindSeparator)
FindSeparator = InStr(FindSeparator + 1, Location, "\")
Loop
EXPORTCONTROL.Cells(3, 3) = Trim(GetPath) 'display only path
Rem EXPORTCONTROL.Cells(3, 3) = Location ' display full name
& path
End If
Rem namesheets (True)
End Sub

Now in my first post in this thread I posted the section of code that
makes the active cell jump to cell C2 if a 1 is entered into any of the
first 100 cells in column A. I want to change it so that the program
only looks at one specific cell (A50) instead of an entire column. Can
I do that? How?
 
L

Lil Pun

Thanks for your assistance Norman but when I implanted your code into my
project it didn't work.
 
N

Norman Jones

Hi Li Pun,
Thanks for your assistance Norman but when I implanted your code into my
project it didn't work.

Then, please show your problematic implementation and indicate the specific
error.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top