Re: Send Value To Specific Cell
Providing you are only using figures:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("C1:G20")) Is Nothing Then 'change to suit
Range("A" & Target.Value).Value = Target.Row 'change to suit
End If
End Subthe above code goes in the worksheet code module you are working with (Alt+F11, then double click the sheet name on your left and paste this in!
Re: Alternate Between 2 Macros With One Button
Quote from AAENice job Simon. (BTW - "Option Explicit" got left out of the code tags)
Thanks and fixed, as for the "Button" i should have stated that but there again the user can adapt the idea of the code to their particular button!
Re: Textbox Format In Userform
I think it should look like htis:
Private Sub UserForm_initialize()
Me.txtWaste.Text = Format(Number, "00.000")
End SubRe: Alternate Between 2 Macros With One Button
Try something like this:
Option Explicit
Public s As Integer ''''This is a publicly declared Integer i.e the value of s can be called upon elsewhere
Private Sub CommandButton1_Click()
If s = 0 Then
MsgBox "Hi" '''Substitute this for first code to run
CommandButton1.Caption = "Ready to Hide"
s = 1
ElseIf s = 1 Then
MsgBox "Bye" '''''substitute this for second code
s = 0
CommandButton1.Caption = "Ready to Show"
End If
End SubRe: Vb That Gives Static Time While Updating A Cell While The Sheet Is Locked
Welcome to Ozgrid, use the code below in the worksheet module of the sheet you are using
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Column <> 1 Then Exit Sub
If Target <> vbNullString And Target.Offset(0, 1) = vbNullString Then
Me.Unprotect Password:="password" ' password would be the one you set for the sheet
Target.Offset(0, 1).Value = Time
Me.Protect Password:="password"
End If
End Submake sure that the cells in column A are unlocked.
Re: Save Monthly Data To New Workbook Named As Month
This works perfect for me:
Sub copy_month_data_new_workbook()
Dim Rng As Range, MyCell As Range
Dim aWorkbook As String
Dim IB As String
aWorkbook = ThisWorkbook.Name
IB = Sheets("Sheet1").Range("A1").Value
Application.ScreenUpdating = False
Set Rng = Sheets("Sheet1").Range("A2:A" & Range("A65536").End(xlUp).Row)
Sheets.Add
ActiveSheet.Name = IB
For Each MyCell In Rng
If Application.WorksheetFunction.Text(MyCell, "mmmm") = IB Then
MyCell.EntireRow.Copy Destination:=Sheets(IB).Range("A65536").End(xlUp).Offset(1, 0)
End If
Next
Sheets(IB).Copy
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\USER\My Documents\" & aWorkbook & " - " _
& IB & ".xls", FileFormat:=xlNormal, ReadOnlyRecommended:=True
ActiveWorkbook.Close
Application.DisplayAlerts = False
Sheets(IB).Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Subdon't forget to change the path, and remember that this is looking for the full month name not Jan but January, if you want to use Jan then remove one of the m's from
If Application.WorksheetFunction.Text(MyCell, "mmmm") = IB ThenRe: Save Monthly Data To New Workbook Named As Month
Just change IB for
Range("A1").Value, Kiz just a word....Dave is right, excel's built in functions are far more efficient and useable, to change destination or what it copies and how in code takes a more time and knowledge, than letting excel do the work for you, take a few minutes to follow daves suggestions to find out how powerful pivot tables are!
Re: Macro To Save New File By Month Name
You can assign thsi macro to a button, you need to change the destination path of the saved workbook, the macro will prompt you for a month enter one press ok and a new workbook will be saved to your designated path with a sheet for that month named as the original workbook plus the month!
Dont forget to change
Quote"C:\Documents and Settings\USER\My Documents\
for your actual path that you want to save it to!
Sub copy_month_data_new_workbook()
Dim Rng As Range, MyCell As Range
Dim IB As String
Dim aWorkbook As String
aWorkbook = ThisWorkbook.Name
IB = InputBox("Enter the month you want to copy!", "Month Selector")
Application.ScreenUpdating = False
Set Rng = Sheets("Sheet1").Range("A2:A" & Range("A65536").End(xlUp).Row)
Sheets.Add
ActiveSheet.Name = IB
For Each MyCell In Rng
If Application.WorksheetFunction.Text(MyCell, "mmmm") = IB Then
MyCell.EntireRow.Copy Destination:=Sheets(IB).Range("A65536").End(xlUp).Offset(1, 0)
End If
Next
Sheets(IB).Copy
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\USER\My Documents\" & aWorkbook & " - " _
& IB & ".xls", FileFormat:=xlNormal, ReadOnlyRecommended:=True
ActiveWorkbook.Close
Application.DisplayAlerts = False
Sheets(IB).Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End SubRe: Macro To Save New File By Month Name
If you had a sheet called the month name wouldn't that have all the data from that month in it?
Re: Find Next Date In Range From Input
try something like
Sub datefind()
Range("A1").Value = Application.WorksheetFunction. _
VLookup(Range("H20"), Columns("D:D"), 1, True)
'using true will find the next nearest date without going past the date
End SubRe: Custom Toolbar .xlb File
i'm not sure that the base file exists in 2007 like that it may be called Excel9
Re: Find Adjacent Data And Copy
Glad i could help, it can be modified to find anything you choose and paste next to anything you choose like this:
Sub Macro2()
Dim IB As String, IB1 As String
IB = InputBox("Enter word to find")
IB1 = InputBox("Enter word to paste next to")
Cells.Find(What:=IB, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Offset(0, 1).Copy Destination:=Cells.Find(What:=IB1, _
After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Offset(0, 1)
End SubEDITED 'COS I LEFT OUT THE INPUTBOXES!
Re: Find Adjacent Data And Copy
Try this:
Sub Macro2()
Cells.Find(What:="Difference", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Offset(0, 1).Copy Destination:=Cells.Find(What:="Ops", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Offset(0, 1)
End SubRe: Vba Macro That Creates Copies Of A Worksheet And Transfers Data Into It And Prints It
You need to supply workbooks showing the stucture you are using, everything you ask i fairly simple, in fact you could use the macro recorder to get you most of the way there just switch it on and perform the actions, take a look at the code which you say you can usually alter to make work for your situation and when you have something near and a workbook we can look at get back to us where we will be glad to help!
Re: Copy Duplicated Numbers Between 2 Sheets
This looks for a count of more than one instance of an entry in column c sheet 1 then if there is copy the entire row to sheet 2 then delete the entry and so on!, just change the sheet names to suit.
Sub Macro1()
Dim Rng1 As Range, MyCell As Range
Sheets("Sheet1").Select
Set Rng1 = Sheets("Sheet1").Range("C2:C" & Range("C65536").End(xlUp).Row)
For Each MyCell In Rng1
If Application.WorksheetFunction.CountIf(Rng1, MyCell.Value) > 1 Then
MyCell.EntireRow.Copy Destination:=Sheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0)
MyCell.EntireRow.Delete Shift:=xlUp
End If
Next MyCell
End Sub[hr]*[/hr] Auto Merged Post Until 24 Hrs Passes;[dl]*[/dl]Cross posted!
http://vbaexpress.com/forum/showthread.php?t=18688
Re: Copy Duplicated Numbers Between 2 Sheets
how about..
Quote from Simondo you want the duplicate numbers deleted after copying?
?
Re: Copy Duplicated Numbers Between 2 Sheets
Are the duplicated numbers in a single column, row or over the whole sheet?, what is the range?, do you want the duplicate numbers deleted sfter copying?
Re: Form To Seach Workbook For A Value
I just used the code below i had a cell with two words in one of which i was looking for, in the input box i entered the word and it found it no problem, i have now fixed it so that it highlights the entire row.
Sub Macro1()
Dim IB As String
Dim rFound As String
IB = InputBox("Enter Value to find", "Value to edit")
If IB = "" Then Exit Sub
For Each Sheet In Sheets
With Sheets(Sheet.Name)
If Sheets(Sheet.Name).Name = "" Then Exit Sub
rFound = .Cells.Find(What:=IB, After:=.Range("A1"), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Address
If .Range(rFound).Value = "" Then GoTo Nxt
If MsgBox("Do you want to edit the data?", vbYesNo, "Data Editing") = vbYes Then
Sheets(Sheet.Name).Select
Range(rFound).EntireRow.Select
Exit Sub
Else: Exit Sub
End If
End With
Nxt:
Next
End SubRe: Form To Seach Workbook For A Value
That seems a lot of code just to find a value!, try this:
Sub Macro1()
Dim IB As String
Dim rFound As String
IB = InputBox("Enter Value to find", "Value to edit")
If IB = "" Then Exit Sub
For Each Sheet In Sheets
With Sheets(Sheet.Name)
If Sheets(Sheet.Name).Name = "" Then Exit Sub
rFound = .Cells.Find(What:=IB, After:=.Range("A1"), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Address
If .Range(rFound).Value = "" Then GoTo Nxt
If MsgBox("Do you want to edit the data?", vbYesNo, "Data Editing") = vbYes Then
Sheets(Sheet.Name).Select
Range(rFound).Select
Exit Sub
Else: Exit Sub
End If
End With
Nxt:
Next
End Subrun the macro, enter the word or number or whatever to look for and take it from there, you should be able to modify it!