Posts by yjoshi

Hi This can be certainly done.. no probs.

I have worked with lot of these before. If you can give a few more pointers to the exact problems, it will be really great.

such as what is the structure of data, how many columns, how many sheets,
do you want to just dump the data one below the other or something else ... etch.

See following code which have used to consolidate data on one sheet from different sheets in the same file.

Sub consolidate()
Sheets("Complete").Select ' Selects the sheet where consolidation is needed
Range("Complete_Data_Clr").Clear ' clears existing data, you may skip this
    For Each Sheet In Sheets
    
    If Sheet.Name <> "Data Analysis" And Sheet.Name <> "Complete" And Sheet.Name <> "Entry Form" And Sheet.Name <> "Consolidate" Then
    ' Excluding some sheets which need not be consolidated 
       nam = Sheet.Name
       data_nam = "=OFFSET(" & nam & "!R2C1,0,0,COUNTA(" & nam & "!R2C1:R4999C1),8)"
       ActiveWorkbook.Names.Add Name:=nam, RefersToR1C1:=data_nam
       ' creating name for data on that sheet. Works easy with other processing
       Sheets(nam).AutoFilterMode = False 'Remove filters if any existing
       Sheets(nam).Range(nam).Copy (Sheets("Complete").Range("A65536").End(xlUp).Offset(1, 0)) 'copy the named range below the last used cell 
    End If
    Next
End Sub

Hi,

I think you can increas performace of your code by this way

Sub CopyTest1()
   Range("A1:H18").Copy Destination:=Range("A65536").End(xlUp).Offset(7, 0)
   Range("A65536").End(xlUp).Select
End Sub

Also, I tested the code and is working fine even with formulae.

Can you tell what is the problem with formulae?

Hi Xlite,

I think your query is not very clear.

What do you mean by "how do you reference a solid path..."

I thought you wanted... how do you reference to a cell in another worksheet as a formula ....
If you want that... following is the code.... , else please clarify.

ActiveCell.FormulaR1C1 = "=Sheet2!RC"

HTH

Very simple

Format -> conditional Formatting -> Condition
Cell Value is -> greater than -> 200

Click on Format

Choose the formatting

Say OK.

Hope this helps.

Yogendra

Try following code:

Sub LockAllSheets1()
If strMasterPassword = "" Then
strMasterPassword = Worksheets(1).Range("E100").Value
End If
Dim wsSheet As Worksheet
On Error Resume Next
For Each wsSheet In Worksheets
    wsSheet.Unprotect Password:=strMasterPassword
    With wsSheet.Range("$A$3:$K$84")
        .Formula = .Value
        .Locked = True
        .FormulaHidden = False
    End With
    wsSheet.Protect Password:=strMasterPassword
    If wsSheet.Name = Me.Name Then Exit Sub
Next wsSheet
On Error GoTo 0
End Sub

The difference from Derk's approach is that i am using Me keyword which will mean, the sheet in which the code resides will be used.

Also looks like you want to lock only the specific range and not all the cells, so i have put the code for locking, hiding formulae in the same with clause.

It did work for me perfectly.

HTH

Ho Wes,

The post is a bit ambiguous!! Not really sure if you want to remove all filters on all sheets or do something special if there is a filter.

Following code will make sure that autofilter for all sheets is set to false, so that your macro can run and will not be affected by the filters.

Sub SeeFilter()
Dim w As Worksheet
For Each w In Worksheets
    w.AutoFilterMode = False
Next w
End Sub

If you post what you are doing in your code, we can suggest some better way!!

Hi Les,

I could use the SAME code to hide the range. It worked.

Just make sure that your sheet is not protected.

Also, as per your requirements, you do not want user to enter anywhere except where you want... why don't you try to unlock the entry fields and then protect?

Hope i am not hitting the wrong nail

Also try:

Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A1") Then ' as A1 contains True / False no need for explicit checking
    'your code
End If
End Sub

Yet Another Approach.... ( I know there can be plenty more)

I am using union of special cells containing constants or formulae (which will exclude the formatted blank cells) and then getting the maximum row and column, adding 1 to row instead of offset.

Sub last_cell()
Dim rng As Range
Dim lrow, lcol As Integer
lrow = 1
lcol = 1
If WorksheetFunction.CountA(Cells) > 0 Then
    Set rng = Union(Cells.SpecialCells(xlCellTypeConstants), _
    Cells.SpecialCells(xlCellTypeFormulas))
    For Each cell In rng
        If cell.Row > lrow Then lrow = cell.Row
        If cell.Column > lcol Then lcol = cell.Column
    Next
Cells(lrow + 1, lcol).Select
End If
End Sub

But i think, because of the for loop, it may not be extremely time efficient....

If you are DEAD-SURE that there are no Blank Cells with formatting, then you can use

cells.SpecialCells(xlCellTypeLastCell).offset(1,0).Select

However this will fail, if there is a blank cell outside the text-entered bloks, with some formatting enabled.

HTH (Hope this helps)

Hi Weasel,
In your code, you are using exactly same if function twise, which can also be avoided.
Also, the selection should be inside if loop, as, if the sheed does not have any entry then the code will error out.

I have made these 2 changes...

Will try to see if i can find any better way...

Sub LastCell1()


Dim LastColumn As Integer
Dim LastRow As Long


If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Columns.
LastColumn = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
'Search for any entry, by searching backwards by Rows.
LastRow = Cells.Find(What:="*", After:=Cells(1, LastColumn), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Cells(LastRow, LastColumn).Offset(1, 0).Select


End If
End Sub

Following code will give you your desired output.

The only change fron the previous solution is that, there is only one Named Rage "Start" and there is no command button. The stop watch starts as soon as the user form is initialized (in our case with a control button from the worksheet.

Hope this helps

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 And IsNumeric(TextBox1.Value) Then
    Sheet1.Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.Value = UserForm1.TextBox1.Value
    Selection.Offset(0, 1).Value = Range("Start").Value
    Selection.Offset(0, 2).Value = Now()
    Selection.Offset(0, 3).Formula = "=RC[-1]-RC[-2]"
    TextBox1.Value = ""
End If
End Sub


Private Sub UserForm_Initialize()
    Range("Start").Value = Now()
End Sub


Private Sub UserForm_Terminate()
    Range("Start").Value = ""
End Sub

Let me give it a try based on the minimum requirement you have written.

This can be used as a starting point and you can improve on the tool or ask for further help.

Steps:
1. On Sheet1 enter 4 headings in A1 to D1 "Number, Start, End, Time"
2. Create three Named Cells (Insert -> Name -> Define) anywhere in the workbook. "Started, Number, Start" (which will be used for storting temp. values)
3. Create a user form in VBE ( Ctrl + F11 to see VBE and then insert -> userform)
4. Create one Text box and one command button on the user form.
5. Paste following code in the code window for user form.

Private Sub CommandButton1_Click()
If Range("Started").Value <> "Stared" Then
    If Not (IsNumeric(UserForm1.TextBox1.Value)) Then MsgBox ("Not valid Number"): Exit Sub
    Range("Started").Value = "Stared"
    Range("Number").Value = UserForm1.TextBox1.Value
    Range("Start").Value = Now()
    UserForm1.CommandButton1.Caption = "Stop"
    UserForm1.TextBox1.Enabled = False
Else
    Sheet1.Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.Value = UserForm1.TextBox1.Value
    Selection.Offset(0, 1).Value = Range("Start").Value
    Selection.Offset(0, 2).Value = Now()
    Selection.Offset(0, 3).Formula = "=RC[-1]-RC[-2]"
    Range("Started").Value = "Stopped"
    Range("Number").Value = ""
    Range("Start").Value = ""
    UserForm1.CommandButton1.Caption = "Start"
    UserForm1.TextBox1.Enabled = True
    Unload Me
End If


End Sub

This should help you record the timings for different players (numbers).

If this is fine with you, we can work on getting the fastest etc.

Hi,

I will strongly suggest use of Text Box instead of merved cells in case you want to write lot of text. This can help you in formatting the things better. Also, you can make the background as No Fill, so that you don't see a white box.

Also, the Row Numbers are a bit confusing. You are mentioning Row E ... is this right, ro you mean column E ?

Worksheets(1) does the processing for first worksheet in the workbook.

If you want to protect all your sheets, you can put it in For loop or do the processing on specific sheet with
follwoing code, where "Protected_Sheet" is the name of the sheet on which the processing is needed.

Private Sub Workbook_Open() 


With Sheets("Protected_Sheet")


    .EnableSelection = xlUnlockedCells 


    .Protect Contents:=True, UserInterfaceOnly:=True 


End With 
 
End Sub

Paste this in cell "C3"

=IF(AND(OR((B3="X"),(B2="X")),NOT(C2=C1)),0,IF(B3="X",A3,IF(A3=B3,A3,"F")))

Logic:

IF
1. B3 or B2 is "X" (Cell besides or above the cell besides)
AND
2. the two cells above the result cells are not equal

Result = 0

Else

formula.
end if

Hope this helps, if not, please clarify the conditions... cheers

Hi Byron,

Welcome to OzGrid!!!

Please help us to help you.

The question is a bit unclear.
Can you let us know what do you mean by "pull correlating 7 columns"?

Also what should happen if we have 4-H more than once... how should we pull / combine the data.

At times it happens in first few posts, that you may be a bit unclear... but do not refrain from posting... we are as eager to help you as you are to get the help

Hi,

I am putting a SIMPLE code to transfer data from Sheet1 to the next blank row in Sheet2.
You can add other flavours like screen updation, selection after paste etc etc.

Just open a blank workbook, paste this code in sheet1 and run it a few times by entering data in sheet1 and selecting the same.

Sub transfer()
Selection.Copy
Sheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

I have taken 4-5 steps in one go.
1. selecting sheet2
2. going to the last cell in A col (A65536)
3. then going up to find last used cell in A col
4. go to next cell
5. paste.

Easy ?? :cool:

Following code should solve your problems.

Not really sure why you used paste special... but you can still replace the paste command with your old command, if you need, and it also works fine.

Sub Copy_to_New_Sheet()
Show = ActiveSheet.Name
Selection.Copy
Sheets.Add
ActiveSheet.Paste
num = InputBox("Enter a valid number")
ActiveSheet.Name = Show + num
Application.CutCopyMode = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets(Show).Select
Range("AA19").Select
End Sub

This will do the trick

If you want it for more worksheets, put it in for loop

Private Sub Workbook_Open()
With Worksheets(1)
    .EnableSelection = xlUnlockedCells
    .Protect Contents:=True, UserInterfaceOnly:=True
End With


End Sub