Posts by Simon Lloyd

Re: Display Warning When In Date Range

Assuming your future date is in D1:
=IF(TODAY()>=D1+60,"Yes","No")

Re: Find Value In Column & Copy Entire Row

You didnt explain that catalogue numbers were made up of Characters and figures!!!
try replacing:

Ib = Application.InputBox("Enter Catalogue number", "Catalogue Number", , , , , , 1)

with:

Ib = InputBox("Enter Catalogue number", "Catalogue Number")

Re: Uk Date Coverting To Us Date

Use the Cells Format either choose DATE or Custom find one in custom that displays dd/mm/yyyy or simply add that to custom.

Re: Selecting A Range Of Cells Of Known Width But Unknown Length.

The whole range can be found like:

Sheets("Sheet1").Range("A2:N" & Range("N" & Rows.Count).End(xlUp).Row)

or the last row in Column N like this:

Sheets("Sheet1").Range("N" & Rows.Count).End(xlUp)

to find the last but one row add

.Offset(-1, 0)

to find the last used column its like this:

Range("IV1").End(xlToLeft).Column

hope these help as i didnt understand what you were after, finally if you want all rows selected except the top and the last then use:

Sheets("Sheet1").Range("A2:N" & Range("N" & Rows.Count).End(xlUp).Row).offset(-1,0).Select

Re: Fill All Rows Across All Columns In Step

Dave i assumed he meant all used rows, otherwise he's in for a big problem!

Re: Adding Value To Multiple Rows?

Dim Cell as Range
with sheets("Sheet1")
for each cell in.Range("A1:" & .Range("A65536").end(xlup)
cell.value="100"
next

repeat changing column letter....not tested, if you have values in the cells already and want to keep them then change

Cell.value=100[code] for

Cell.value=cell.value & " 100"[/CODE]

Re: Combine Workbooks With Multiple Sheets Into 1 Multiple Sheet Workbook

Thanks Dave, i think it's because there are 2 workbooks.open in there. Wendy Dave's suggestion is to add

Application.DisplayAlerts=False

underneath the DIM statements and then

Application.DisplayAlerts=True

after NEXT

Re: Copy Rows Between Sheets

Try this:

Sub Macro1()
Dim Ib As String
Dim rFound As Range
Ib = Application.InputBox("Enter Catalogue number", "Catalogue Number", , , , , , 1)
   rFound = Cells.Find(What:=Ib, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Address
        Range(rFound).EntireRow.Copy Destination:=Sheets("Report").Range("A65536").End(xlUp).Offset(1, 0)
End Sub

Re: Copy Rows Between Sheets

Maybe so but it will only ever copy the first 15 rows! if you have more rows they will be left out, if you anticipate more rows use:

Set Rng = Sheets("Sales").Range("A2:F" & Range("F" & Rows.Count).End(xlUp).Row)

this will now copy as many rows as there are, i set it from A2 to allow for a header row.

Re: Copy Rows Between Sheets

Hi you didnt say which 15 rows or whether it would change and you didnt say which 6 cells, however this macro copies the first 15 rows x 6 columns from the Sales sheet and puts them on the Report sheet.

Sub Macro2()
Dim Rng As Range
Set Rng = Sheets("Sales").Range(Cells(1, 1), Cells(15, 6))
Rng.Copy Destination:=Sheets("Report").Range("A65536").End(xlUp).Offset(1, 0)
End Sub

Re: Combine Workbooks With Multiple Sheets Into 1 Multiple Sheet Workbook

Are you using Excel 97?
Anyway i have added an error handler maybe it will help!

Sub test()
    Dim myDir As String, fn As String
    Dim WSName As String
    Dim WB As Excel.Workbook
    WSName = "Sheet1" ' <-- Change as desired.
     On Error GoTo Nxt
    Application.ScreenUpdating = False
    myDir = "C:\test" '<- change here to actual folder path
    fn = Dir(myDir & "\*.xls")
     
    Do While fn <> ""
        Set WB = Application.Workbooks.Open(myDir & "\" & fn)
        If MySheetExists(WB, WSName) Then
             'Sheet  name exists
        Else
             ActiveWorkbook.Close (False)
            GoTo Nxt
        End If
        With Workbooks.Open(myDir & "\" & fn)
             
            With .Sheets("Sheet1")
                .Name = .Name & "-" & fn
                .Copy Before:=ThisWorkbook.Sheets(1)
            End With
            .Close False
        End With
Nxt:
        fn = Dir
     Loop
    Application.ScreenUpdating = True
End Sub
Public Function MySheetExists(WB As Excel.Workbook, WSName As String) As Boolean
    Dim WS As Excel.Worksheet
    On Error Resume Next
    Set WS = WB.Worksheets(WSName)
    MySheetExists = Not (WS Is Nothing)
End Function

Re: Count If- Bank Reconciliation

Something like this:
=IF(COUNTIF($B1:$B$1000,D1),0,"")

Re: Combine Workbooks With Multiple Sheets Into 1 Multiple Sheet Workbook

What error number? did you change the Path in

myDir = "C:\test"

it should be your own path that your folder is in like:

myDir = "C:\Users\Wendy\Documents"

this is how it would look if you were using Windows Vista and the folder you were looking in was "Documents". Also did you change "Sheet1" in the example for the sheet you are looking for?

Re: Combine Workbooks With Multiple Sheets Into 1 Multiple Sheet Workbook

Wendy, just a couple of additions to Jindon's code (if you don't object Jindon), if you open a workbook and the sheet does not exist then the code will halt with an error, i have added a function and additions to the code to check for this!

Sub test()
    Dim myDir As String, fn As String
    Dim WSName As String
    Dim WB As Excel.Workbook
    WSName = "Sheet1"   ' <-- Change as desired.
    
Application.ScreenUpdating = False
    myDir = "C:\test" '<- change here to actual folder path
    fn = Dir(myDir & "\*.xls")


    Do While fn <> ""
    Set WB = Application.Workbooks.Open(myDir & "\" & fn)
        If MySheetExists(WB, WSName) Then
            'Sheet name exists
        Else
        ActiveWorkbook.Close (False)
            GoTo Nxt
    End If
        With Workbooks.Open(myDir & "\" & fn)
       
            With .Sheets("Sheet1")
                .Name = .Name & "-" & fn
                .Copy Before:=ThisWorkbook.Sheets(1)
            End With
            .Close False
        End With
Nxt:
        fn = Dir
     Loop
     Application.ScreenUpdating = True
End Sub
Public Function MySheetExists(WB As Excel.Workbook, WSName As String) As Boolean
Dim WS As Excel.Worksheet
    On Error Resume Next
    Set WS = WB.Worksheets(WSName)
    MySheetExists = Not (WS Is Nothing)
End Function

Re: Absolute Reference Multiple Cells At One Time

depends how you want to do it is it for an intersect or an array range or...? we need more information!

Re: Protect All Sheets Then Save

Well, i am glad that Bill, I and Ozgrid could help you out, we just push in the right direction we cant make you learn but if you get something from it all the better....all the best.

Re: Open Workbook From Macro Using Variables

My thinking too norie as i tried the code in xl2000, xl2003, xl2007 and it worked perfect!

Re: Protect All Sheets Then Save

Bill, i provided that alternative because of this at the end of Tom's post:

Quote from Tom

Simon & Bill, I had forgotten to see if just SAVING the document invoked the protection... it does not... Thoughts?
Thanks
Tom

I just thought it would better demonstrate to Tom the events that were happening rather than just copying the code to the Before_Save[hr]*[/hr] Auto Merged Post Until 24 Hrs Passes;[dl]*[/dl]Also Bill Tom posted this:

Quote from Tom

I am assuming too that I can add other duties in this script before closing, such as unhiding all rows, and returning to A1 etc

so it saves on confusion for him if he is trying to integrate other code with what he already had in the before close, now he has a clean sheet to work with!

Re: Protect All Sheets Then Save

Velknost, you would have to have the code in another module like this:
these go in the ThisWorkbook module:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call MyProtect
End Sub


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call MyProtect
End Sub

This one goes in a standard module:

Sub MyProtect()
Dim wsSheet As Worksheet
    For Each wsSheet In Sheets
        wsSheet.Protect Password:="p", DrawingObjects:=False, Contents:=True, Scenarios:= _
        True, AllowInsertingRows:=True, AllowFiltering:=True
        wsSheet.EnableSelection = xlUnlockedCells
    Next wsSheet
     ThisWorkbook.Save
End Sub

Re: Protect All Sheets Then Save

Thanks for picking that up Bill, if you were to use AAE's solution you would have to specify each and every sheet in the array, the way i supplied will run through each sheet regardless, and as Bill said if you use a variable for anything the Declare it otherwise Excel will just treat it as variant, here's the code tidied, you don't need to name each sheet like sheet1.protect.... sheet2.protect because you are using the same settings for each sheet!

Option Explicit 
 
Private Sub Workbook_BeforeClose(Cancel As Boolean) 
Dim wsSheet As Worksheet
     
    For Each wsSheet In Sheets
        wsSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        True, AllowInsertingRows:=True, AllowFiltering:=True
        wsSheet.EnableSelection = xlUnlockedCells
    Next wsSheet
    ThisWorkbook.Save
End Sub